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Preface 


The  purpose  of  IDA  Memorandum  Report  459  is  to  identify  and  describe  a  version  of  a 
software  delivery,  ”An  Oracle  -  Ada/SQL  Implementation,”  to  the  WIS  Joint  Program  Manage¬ 
ment  Office.  The  term  version  is  applied  to  the  initial  release  as  well  as  to  all  interim  changes. 

This  report  was  written  to  describe  the  software  developed  to  satisfy  deliverable  5.a  under 
task  order  T-W5-206,  entitled  WIS  Application  Software  Study.  The  purpose  of  this  software 
system  is  to  provide  a  Level  1  Ada/SQL  implementation  which  interacts  with  the  Oracle®  data¬ 
base  management  system.  This  software  provides  the  ability  to  define  Ada/SQL  Data  Definition 
Language  (DDL)  and  Ada/SQL  Data  Manipulation  Language  (DML)  which  will  be  converted 
into  the  appropriate  SQL  calls  required  by  the  Oracle  DBMS. 


ORACLE  is  a  registered  trademark  of  Oracle  Corporation. 
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1.  SCOPE 


1.1  System  Overview 

The  purpose  of  this  software  system  is  to  provide  a  Level  1  Ada/SQL  implementation  which 
interacts  with  the  Oracle  database  management  system.  This  software  provides  the  ability  to 
define  Ada/SQL  Data  Definition  Language  (DDL)  and  Ada/SQL  Data  Manipulation  Language 
(DML)  which  will  be  converted  into  the  appropriate  SQL  calls  required  by  the  Oracle  DBMS. 
Ada/SQL  is  a  binding  between  the  Ada  programming  language  [ADA  83]  and  the  database  pro¬ 
gramming  language  SQL  [SQL  86].  Ada/SQL,  like  SQL,  is  comprised  of  two  main  components: 
a  DDL  and  a  DML.  Both  of  these  are  coded  using  pure  Ada  syntax  and  semantics.  TTie  DDL 
resides  in  a  package  specification,  and  is  used  to  define  the  data  types,  variable  definitions,  and 
table  and  column  definitions.  The  DML  is  expressed  as  syntax  very  similar  to  the  syntax  of  SQL 
DML.  This  expression  is  allowed  due  to  a  set  of  underlying  operators  and  subprograms  which 
must  be  ’withed’  by  the  application.  A  tool  which  aids  in  the  generation  of  these  subprograms, 
named  the  application  scanner,  is  available  as  IDA  Memorandum  Report  M-460  [IDA  88].  The 
use  of  the  application  scanner  tool  is  necessary  for  this  particular  prototype  to  function  properly. 

This  specific  version  of  Ada/SQL  is  named  Level  1  Ada/SQL.  The  Level  1  definition  can  be 
found  in  [ADA  87].  The  limitations  and  constraints  placed  on  Ada/SQL  for  Level  1  reflect  a 
desire  to  produce  a  working  prototype  as  quickly  as  possible,  without  losing  the  benefit  of  Ada’s 
strong  typing  and  enumeration  types.  This  work  was  based  on  the  Ada/SQL  definition  found  in 
[IDA  86]. 

1.2  Documentation  Overview 

The  file  [BBRYKCZYN.EXAMPLEjREAD.ME  is  included  on  the  magnetic  tape  containing 
the  Oracle  Ada/SQL  implementation  and  the  application  scanner.  This  file  contains  guidelines 
which  show  the  user  how  to  create  an  Ada/SQL  application,  use  the  application  scanner,  and  in 
what  order  to  compile  the  output  from  the  scanner.  The  directory  located  in 
[BBRYKCZYN. EXAMPLE]  provides  a  comprehensive  example  of  using  the  Ada/SQL  system. 
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3.  VERSION  DESCRIPTION 


3.1  Inventory  of  Materials  Released 

This  prototype  Ada/SQL  system  was  developed  on  a  VAX™  8600,  using  VAX/VMS  version  4.6, 
and  die  DEC  Ada  compiler,  version  1.4-33.  The  magnetic  tape  upon  which  the  source  is  located 
is  in  VAX/VMS  backup  format,  and  the  save  set  name  is  ADASQL.  This  tape  requires  8192 
blocks  of  memory.  To  load  the  tape,  allocate  the  tape  drive  desired,  request  a  tape  mount,  and 
issue  the  following  command:  “BACKUP  MUAO:  [appropriate  directory...]*.*.*”,  where 
MU  AO  is  the  logical  tape  drive  name,  and  appropriate  directory  is  the  directory  in  which  you  will 
be  placing  the  contents  of  the  tape. 

Located  on  the  tape  is  a  file  named  READ. ME.  This  file  contains  instructions  for  executing  the 
example  queries  found  in  the  [.EXAMPLE]  directory.  Note  that  the  use  of  this  example  assumes 
the  use  of  the  application  scanner. 


3.2  Inventory  of  Software  Prototype  Contents 

The  following  are  the  files  which  make  up  the  prototype  Ada/SQL  system.  They  are  listed  in 
compilation  order. 

DATABASE.  ADA 
TXTPRTS  .ADA 
TXTPRTB.ADA 
ORDEFS.ADA 
ORCUDEFS .  ADA 
ORHLIS.ADA 
ORINTS.ADA 
FUNCTIONS. ADA 
ORINTB.ADA 
FUNCTIONB.ADA 
CURSORJDEFINITION.ADA 
SCHEMA_DEFINTTION .  AD  A 

Portions  of  this  software  were  developed  by  SAIC  Comsy stems,  under  contract  by  the  WIS 
Joint  Program  Management  Office,  and  are  located  in  the  Naval  Ocean  Systems  Center  (NOSC) 
TECR  software  repository. 

In  addition,  an  example  set  of  DDL  and  DML  are  located  in  the  [.EXAMPLE]  directory.  See 
[.EXAMPLE]READ.ME  for  details. 


VAX  is  a  trademark  of  Digital  Equipment  Corporation. 
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3.3  Changes 
Not  applicable. 

3.4  Adaptation  Data 
Not  applicable. 

3.5  Interface  Compatibility 
Not  applicable. 

3.6  Bibliography  of  Reference  Documents 

Date,  C.J.  A  guide  to  the  SQL  standard.  New  York:  Addison- Wesley,  1987 

Brykczynski,  Bill  and  Fred  Friedman.  Ada/SQL  binding  specifications.  Alexandria,  VA:  Insti¬ 
tute  for  Defense  Analyses,  1988.  IDA  Memorandum  Report  M-362. 

3.7  Summary  of  Changes 
Not  applicable. 

3.8  Installation  Instructions 

To  load  the  tape,  allocate  the  tape  drive  desired,  request  a  tape  mount,  and  issue  the  following 
command:  “BACKUP  MUAO:  [appropriate  directory...]*.*.*",  where  MUAO  is  the  logical  tape 
drive  name,  and  appropriate  directory  is  the  directory  in  which  you  will  be  placing  the  contents 
of  the  tape. 

3.9  User  Guidelines 

The  following  is  a  set  of  guidelines  for  using  the  VAX/VMS  Level  1  Ada/SQL  system.  These 
guidelines  assume  that  a  directory  exists  which  contains  the  files  loaded  from  tape.  The  files  on 
the  tape  were  loaded  from  a  directory  named  [BBRYKCZYN. ORACLE].  Of  course,  when  a 
tape  is  loaded  on  another  system,  this  path  name  will  be  different. 

1)  Create  the  ADA SQLSENV  logical 

There  are  several  files  which  are  read  by  the  application  scanner  to  establish  a  predefined 
environment  for  pressing  application  programs.  These  files  are  DATABASE. ADA, 
CURSOR_DEFINITION.ADA,  and  STANDARD. ADA.  These  files  are  not  source  files  that 
are  linked  with  the  Ada/SQL  application  programs.  They  must,  however,  be  stored  in  a  direc¬ 
tory  that  is  accessible  via  the  VAX/VMS  logical  name  ADASQLSENV  whenever  the  application 
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scanner  is  run.  These  files  should  not  be  compiled  or  otherwise  used  for  any  purpose  other  than 
that  described  here.  To  assign  the  logical,  type  in  the  following: 

ASSIGN  (BBRYKCZYN.ORACLE. STANDARDS]  ADASQL$ENV 

2)  Copy  over  the  AUTH_P ACK .ADA  file 

In  SQL,  a  module  must  contain  an  authorization  identifier  which  identifies  the  user.  In 
Ada/SQL,  the  authorization  identifier  must  reside  in  a  file  called  AUTH_PACK.ADA.  At  this 
time,  it  is  necessary  only  to  copy  an  AUTH_PACK.ADA  from  another  directory  and  compile  it 
into  the  library.  A  sample  AUTH_PACK.ADA  is  located  in 
[BBRYKCZYN.ORACLE.EXAMPLE] 

3)  Create  the  Ada/SQL  application  specific  files 

There  are  four  files  one  must  create  in  order  to  use  Ada/SQL.  These  are  the  _TYPES.ADA, 
_ VARIABLES. ADA,  _DDL.ADA  packages,  and  the  main  program.  The  files  must  be  named 
exactly  as  the  package  name,  with  the  addition  of  a  ’.ADA’  suffix.  Examples  of  these  files  are 
included  in  the  [BBRYKCZYN.ORACLE.EXAMPLE]  directory. 

4)  Create  the  Oracle  DDL 

It  is  necessary  for  Oracle  to  have  the  data  definition  exist  prior  to  the  running  of  an  Ada/SQL 
program.  If  you  are  building  an  Ada/SQL  program  to  access  a  pre-existing  database  definition, 
this  step  can  be  deleted.  If  you  are  building  a  new  application,  it  will  be  necessary  to  invoke  Ora¬ 
cle,  and  create  the  appropriate  table  and  column  definitions. 

5)  Run  the  scanner 

To  execute  the  application  scanner,  type  in  the  following  command:  “RUN 
[BBRYKCZYN.ORACLE. APSCAN_SOURCE]APSC AN  .EXE” .  The  application  scanner 
will  prompt  you  with  several  questions: 

a)  Enter  DML  filename: 

Here  you  enter  the  name  of  your  Ada  compilation  unit  which  contains  DML  statements 
which  you  want  processed  by  the  application  scanner.  An  output  file  will  be  generated 
where  errors  in  the  DDL  will  be  reported.  This  file  will  have  the  name  of  your  compilation 
unit’s  library  name,  suffixed  with  .DDLOUT.  For  example  enter  BELL.  ADA  here  (the  sub¬ 
program  name  is  BILL)  and  any  DDL  errors  will  be  listed  in  a  file  called  BELL.DDLOUT. 

b)  Enter  listing  filename: 

Here  you  enter  the  name  of  a  file  where  the  application  scanner  will  report  errors  in  the 
DML.  For  example  if  you  had  entered  BELL.ADA  for  question  one  you  could  enter 
BELL.LST  here.  Only  DML  errors  will  be  reported  here,  DML  errors  are  in  the 
•.DDLOUT  file. 

c)  Enter  filename  for  generated  functions: 

Here  you  enter  the  file  name  for  the  compilation  unit  which  will  contain  the  functions 
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necessary  to  make  your  DML  compilation  unit  compilable.  This  will  be  an  Ada  compila¬ 
tion  unit  which  will  become  a  part  of  your  program.  For  example  if  you  had  entered 
BILL.ADA  for  question  one  you  could  enter  BILL-AD  A-SQL.AD  A  here.  The  library 
unit  name  for  this  compilation  unit  will  be  the  library  unit  name  of  your  compilation  unit 
with  an  extension  of  _ADA_SQL.  The  subprogram  name  in  BILL.ADA  is  BILL),  and  the 
library  unit  name  of  the  compilation  unit  BILL_ADA_SQL.ADA  will  be 
BILL_ADA_SQL.  Your  compilation  unit  must 

The  application  scanner  will  then  notify  you: 

Invoking  application  scanner  with: 

DML  filename  s>  file  name  yon  entered  in  #1  above 
Listing  filename  —>  file  name  you  entered  in  #2  above 
Generated  package  —>  file  name  yon  entered  in  #3  above 

When  the  application  scanner  is  complete  it  will  issue  the  message: 

%ADASQL*I-SCAN,  Scan  completed  with  errors 
or  the  message: 

%ADASQL-I-SCAN,  Scan  completed  with  no  errors 

In  the  case  of  ’with  errors’  check  the  *.DDLOUT  file  to  make  sure  the  DDL  scanned  correctly, 
then  check  the  listing  file  you  specified  in  # 2  above  to  see  if  there  was  an  error  in  the  DML. 
Correct  the  errors  and  run  the  application  scanner  again.  In  the  case  of  ’with  no  errors’  you 
must  still  check  the  *.  DDL  OUT  file.  If  errors  are  reported  in  this  file  but  not  in  the  listing  file 
the  message  at  the  end  of  the  application  scanner  will  indicate  no  errors. 

Repeat  these  steps  until  you  have  generated  a  function  package  through  the  application  scanner 
for  all  your  compilation  units  which  contain  DML.  The  package  generated  by  the  application 
scanner  must  be  withed  in  your  compilation  unit. 

6)  Compile  the  output  of  the  scanner 

When  a  correct  version  of  Ada/SQL  DML  is  processed  by  the  scanner,  a  generated  package  will 
be  produced  which  must  be  compiled.  This  package  contains  the  various  subprograms  which 
allow  the  Ada/SQL  DML  to  interact  with  the  database. 

7)  Compile  and  link  the  DML  package 

After  compiling  the  generated  *_ADA_SQL.ADA  package  from  the  previous  step,  the 
Ada/SQL  DML  package  may  now  be  compiled.  Continuing  with  the  example,  this  file  is  named 
BILL.ADA.  After  compiling,  the  file  must  be  linked,  which,  in  this  example,  results  in  an  exe¬ 
cutable  named  BILL. 

8)  Execute  the  application 

3.10  Source  Listings 
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3.10.1  package  DATABASE. ADA 

package  DATABASE  is 

type  INT  is  new  STANDARD . INTEGER; 

type  DOUBLE_PRECISZON  is  new  STANDARD . FLOAT ; 
type  CHAR  is  new  STANDARD . STRING ; 

type  CHAR_LINK  is  access  CHAR; 

type  USER_AUTHORIZATION_IDENTIFIER  is  new  STANDARD. STRING; 
type  DSER_AUTHORIZATION_IDENTIFIER_LINK  is  access 
USER_AUTHORIZATION_IDENTIFIER ; 
type  COLUMN_NUMBER  is  new  STANDARD . INTEGER; 
end  DATABASE; 

3.10.2  package  TXTPRTS. ADA 

—  txtprts.ada  -  print  utilities 

with  TEXT_IO; 

use  TEXT_IO; 
package  TEXT_PRINT  is 

type  BUFFER_ACCESS_TYPE  is  access  STRING; 

type  QUERY_BUFFER_RECORD  is 
record 

QUERY_LENGTH  i  INTEGER  0; 

QUERY_BUFFER  !  BUFFER_ACCESS_TYPE; 
end  record; 

type  ACCESS_QUERY_BUFFER  is  access  QUERY_BUFFER_RECORD ; 

procedure  SETJBUFFER  (  BUFFER  :  ACCESS_QUERY_BUFFER  ); 

procedure  UNSET_BUFFER; 

type  LINE_TYPE  is  limited  private; 

type  BREAK_TYPE  is  (BREAK,  NO_BREAK) ; 

type  PHANTOMJTYPE  is  private; 

procedure  CREATE_LINE ( LINE  :  in  out  LINE_TYPE;  LENGTH  :  in  POSITIVE); 
procedure  SET_LINE ( LINE  :  in  LINE_TYPE ) ; 
function  Cv..iRENT_LINE  return  LINE_TYPE; 

procedure  SET_INDENT ( LINE  :  in  LINE_TYPE;  INDENT  :  in  NATURAL); 

procedure  SET_INDENT ( INDENT  :  in  NATURAL); 

procedure  SET_CONTINUATION_INDENT( LINE  :  in  LINE_TYPE ; 
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INDENT  :  in  INTEGER); 
procedure  SET_CONTINUATION_INDENT{ INDENT  :  in  INTEGER); 

function  MAKE_PHANTOM(S  :  STRING)  return  PHANTOMJTYPE; 

procedure  SET_PHANTOMS ( LINE  :  in  LINEJTYPE; 

START_PHANTOM , 

END_PHANTOM  :  in  PHANTOMJTYPE ) ; 

procedure  SET_PHANTOMS(START_PHANTOM,  END_PHANTOM  :  in  PHANTOMJTYPE) 


procedure  PRINT (FILE 

in 

FILEJTYPE; 

LINE 

in 

LINEJTYPE; 

ITEM 

in 

STRING; 

BRK 

in 

BREAKJTYPE 

BREAK); 

procedure  PRINT (FILE 

in 

FILE_TYPE; 

ITEM 

in 

STRING; 

BRK 

in 

BREAKJTYPE 

BREAK); 

procedure  PRINT (LINE 

in 

LINEJTYPE ; 

ITEM 

in 

STRING; 

BRK 

in 

BREAKJTYPE 

BREAK); 

procedure  PRINT (ITEM 

in 

STRING; 

BRK 

in 

BREAK_TYPE 

BREAK); 

procedure  PRINTLINE  (FILE  :  in  FILEJTYPE;  LINE  s  in  LINEJTYPE)  ; 
procedure  PRINT_LINE ( FILE  :  in  FILEJTYPE) ; 
procedure  PRINT_LINE ( LINE  :  in  LINEJTYPE) ; 
procedure  PRINT_LINE; 

procedure  BLANK_LINE ( FILE  :  in  FILEJTYPE;  LINE  :  in  LINEJTYPE ) ; 
procedure  BLANKJLINE { FILE  :  in  FILEJTYPE); 
procedure  BLANK_LINE ( LINE  :  in  LINE_TYPE) ; 
procedure  BLANK_LINE ; 

generic 

type  NOM  is  range  <>; 
package  INTEGER_PRINT  is 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  in  LINEJTYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK); 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK JTYPE  BREAK); 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  BREAK); 

procedure  PRINT ( ITEM  :  in  NUM; 

BRK  :  in  BREAK  JTYPE  : -  BREAK); 
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procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM) 
end  INTEGER_PRINT ; 


generic 

type  NUM  is  digits  <>; 
package  PLOAT_PRINT  is 


procedure  PRINT (PILE 

in 

FILEJTYPE; 

LINE 

in 

LINE_TYPE; 

ITEM 

in 

NUM; 

BRK 

in 

BREAK_TYPE 

BREAK); 

procedure  PRINT (FILE 

in 

FILE_TYPE; 

ITEM 

in 

NUM; 

BRK 

in 

BREAK_TYPE 

BREAK); 

procedure  PRINT (LINE 

in 

LINE_TYPE; 

ITEM 

in 

NUM; 

BRK 

in 

BREAK_TYPE 

BREAK); 

procedure  PRINT (ITEM 

in 

NUM; 

BRK 

in 

BREAK_TYPE 

:«  BREAK); 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM) 
end  FLOAT_PRINT; 

NULL_PHANTOM  :  constant  PHANTOMJEYPE; 

LAYOUT_ERROR  :  exception  renames  TEXT_IO. LAYOUT_ERROR; 
private 

type  PHANTOM_TYPE  is  access  STRING; 


type  LINE_REC( LENGTH  :  INTEGER)  is 


record 

USED_YET 

BOOLEAN 

-  FALSE; 

INDENT 

INTEGER 

-  0; 

CONTINUATION_INDENT 

INTEGER 

-  2; 

BREAK 

INTEGER 

-  1; 

INDEX 

INTEGER 

-  1; 

DATA 

STRING (1 

.LENGTH) ; 

START_PHANTOM, 

END_PHANTOM 

PHANTOM_TYPE  NULL_PHANTOM ; 

end  record; 

type  LINE_TYPE  is  access  LINE_REC ; 

NULL_PHANTOM  :  constant  PHANTOM_TYPE  new  STRING '(""); 
end  TEXT_PRINT; 


11 

UNCLASSIFIED 


UNCLASSIFIED 


3.10.3  package  TXTPRTB.ADA 
—  txtprtb.ada  -  print  utilities 
package  body  TEXT_PRINT  is 
DEFAULT_LINE  s  LINE_TYPE; 

CURRENT_BUFFER  :  ACCESS_QUERY_BUFFER  null; 

procedure  SET_BUFFER  (  BUFFER  :  ACCESS_QUERY_BUFFER  )  is 
begin 

CURRENT_BUFFER  BUFFER; 
end  SET_BUFFER, 

procedure  UNSET_BUFFER  is 
begin 

CURRENT_BUFFER  null; 
end  UNSET  JBUFFER; 

procedure  CREATE_LINE ( LINE  :  in  out  LINE_TYPE;  LENGTH  :  in  POSITIVE)  is 
begin 

LINE  new  LINE_REC( LENGTH) ; 
end  CREATE_LINE; 

procedure  SET_LINE ( LINE  :  in  LINE_TYPE)  is 
begin 

DEFAULT_LINE  LINE; 
end  SET_LINE; 

function  CURRENT_LINE  return  LINE_TYPE  is 
begin 

return  DEFAULT_LINE ; 
end  CURRENT_LINE; 

procedure  SET_INDENT ( LINE  :  in  LINEJTYPE;  INDENT  :  in  NATURAL)  is 
begin 

if  CURRENT_BUFFER  /-  null  then 
return; 
end  if; 

if  INDENT  >-  LINE. LENGTH  then 
raise  LAY0UT_ERR0R ; 
end  if; 

if  LINE. INDEX  -  LINE. INDENT  +  1  then 
for  I  in  1 . . INDENT  loop 
LINE.DATA(I)  '  '; 
end  loop; 

LINE. INDEX  INDENT  +  1; 
end  if; 

LINE. INDENT  INDENT; 

end  SET_INDENT ; 
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procedure  SET_INDENT ( INDENT  :  in  NATURAL)  is 
begin 

SET_INDENT ( DEFAULT_LINE , INDENT ) ; 
end  SET_INDENT ; 

procedure  SET_CONTINUATION_INDENT ( LINE  :  in  LINE_TYPE; 

INDENT  :  in  INTEGER)  is 

begin 

if  CURRENTJBUFFER  /-  null  then 
return; 
end  if; 

if  LINE. INDENT  +  INDENT  >«  LINE. LENGTH  or  else  LINE. INDENT  +  INDENT  <  0 
then 

raise  LAYOUT_ERROR ; 
end  if; 

LINE . CONTINUATION_INDENT  :«  INDENT; 
end  SET_CONTINUATION_INDENT ; 

procedure  SET_CONTINUATION_INDENT ( INDENT  :  in  INTEGER)  is 
begin 

SET_CONTINUATION_INDENT(DEFAULT_LINE, INDENT ) ; 
end  SET_CONTINUATION_INDENT ; 

function  MAKE_PHANTOM( S  !  STRING)  return  PHANTOM_TYPE  is 
begin 

return  new  STRING' (S); 
end  MAKE_PHANTOM; 

procedure  SET_PHANTOMS ( LINE  :  in  LINEJTYPE; 

START_PHANTOM, 

END_PHANTOM  :  in  PHANTOM_TYPE )  is 

begin 

if  CURRENT_BUFFER  /-  null  then 
return; 
end  if; 

LINE . START_PHANTOM  START_PHANTOM ; 

LINE . END_PHANTOM  :=  END_PHANTOM ; 
end  SET_PHANTOMS; 

procedure  SET_PHANTOMS (  START_PHANTOM ,  END_P HANT OM  :  in  PHANTOM_TYPE ) 
is 

begin 

SET_PHANTOMS(DEFAULT_LINE,  ST ART_PHANTOM ,  END_PHANTOM )  ; 
end  SET_PHANTOMS; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  :  in  LINEJTYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  BREAK)  is 

NEW_BREAK,  NEW_INDEX  :  INTEGER; 
begin 
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if  CURRENT_BUFFER  /-  null  then 
NEW_INDEX  :» 

CURRENT_BUFFER . QUERY_BUFFER ' FIRST  +  CURRENT_BUFFER . QUERY_LENGTH ; 
NEW_BREAK  NEW_INDEX  +  ITEM' LENGTH  -  1/ 
if  NEW_BREAK  >  CURRENT_BUFFER . QUERY_BUFFER ' LAST  then 
raise  LAYOUT_ERROR ; 
end  if; 

CURRENT_BUFFER . QUERY_BUFFER  (  NEW_INDEX  ..  NEW_BREAK  )  ITEM; 
CURRENT_BUFFER . Q UERY_LEN GTH 
CURRENT_BUFFER . QUERY_LENGTH  +  ITEM' LENGTH; 
return; 
end  if; 

if  LINE. INDEX  +  ITEM' LENGTH  +  LINE . END_PHANTOM ' LENGTH  > 

LINE. LENGTH  +  1 
then 

if  LINE. INDENT  +  LINE . CONTINUATION_INDENT  + 

LINE . STARTJPHANTOM' LENGTH  + 

LINE. INDEX  -  LINE. BREAK  +  ITEM' LENGTH  >  LINE. LENGTH  then 
raise  LAYOUT_ERROR ; 
end  if; 

if  ITEM  -  "  "  and  then  LINE. END_PHANTOM. all  -  ""  then 
return; 
end  if; 

PUT_LINE ( FILE , LINE . DATA ( 1 . . LINE . BREAK-1 )  &  LINE . END_PHANTOM . all ) ; 
for  I  in  1. .LINE. INDENT  +  LINE . CONTINUATION_INDENT  loop 
LINE . DATA ( I )  '  '; 

end  loop; 

NEW_BREAK  LINE. INDENT  +  LINE . CONTINUATION_INDENT  +  1; 

NEW_INDEX  NEW_BREAK  +  LINE . START_PHANTOM' LENGTH  + 

LINE. INDEX  -  LINE. BREAK; 

LINE . DATA ( NEW_BREAK . . NEW_INDEX- 1 )  LINE . START_PHANTOM .all  & 

LINE. DAT A (LINE. BREAK. . LINE . INDEX- 1) ; 

LINE. BREAK  NEW_BREAK ; 

LINE. INDEX  NEW_INDEX; 
end  if; 

NEW_INDEX  LINE. INDEX  +  ITEM' LENGTH; 

LINE . DATA ( LINE . INDEX . . NEW_INDEX- 1 )  ITEM; 

LINE. INDEX  :«  NEW_INDEX ; 
if  BRK  -  BREAK  then 

LINE. BREAK  : -  NEW_INDEX; 
end  if; 

LINE . USED_YET  TRUE; 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  BREAK)  is 

begin 

PRINT ( FILE , DEFAULT_LINE , ITEM , BRK ) / 
end  PRINT; 
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procedure  PRINT (LINE  :  in  LINEJTYPE ; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  : «  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  STRING;  BRK  :  in  BREAK_TYPE  BREAK)  is 
begin 

PRINT ( CURRENT_OUTPUT, DEFAULT_LINE, ITEM, BRK ) ; 
end  PRINT; 

procedure  PRINTLINE  (FILE  :  in  FILEJTYPE;  LINE  :  in  LINEJTYPE)  is 
begin 

if  CURRENT_BUF FER  /»  null  then 

if  CURRENT_BUFFER.QUERY_LENGTH  /*  0  then 
PRINT  (  "  "  ); 
end  if; 
return; 
end  if; 

if  LINE. INDEX  /-  LINE. INDENT  +  1  then 

PUT_LINE( FILE, LINE . DATA( 1 . . LINE . INDEX-1 ) ) ; 
end  if; 

for  I  in  1. .LINE. INDENT  loop 
LINE.DATA(I)  :«  '  '; 
end  loop; 

LINE. INDEX  LINE. INDENT  +  1; 

LINE. BREAK  LINE. INDEX; 
end  PRINT_LINE; 

procedure  PRINT_LINE ( FILE  :  in  FILE_TYPE)  is 
begin 

PRINT_LINE ( FILE , DEFAULT_LINE ) ; 
end  PRINT_LINE; 

procedure  PRINT_LINE ( LINE  :  in  LINEJTYPE)  is 
begin 

PRINT_LINE ( CURRENT_OUTPUT , LINE ) ; 
end  PRINT_LINE; 

procedure  PRINT_LINE  is 
begin 

PRINT_LINE ( CURRENT_OUTPUT , DEF AULT_L INE ) ; 
end  PRINT_LINE; 

procedure  BLANK_LINE (FILE  :  in  FILE_TYPE;  LINE  :  in  LINEJTYPE )  is 
begin 

if  CURRENT_BUFFER  /-  null  then 
return ; 
end  if; 

if  LINE. USED  YET  then 
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NEW_LINE ( PILE ) ; 
end  if; 

end  BLANK_LINE; 

procedure  BLANK_LINE( FILE  :  in  FILEJTYPE)  is 
begin 

BLANK_LINE ( FILE , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

procedure  BLANK_LINE ( LINE  :  in  LINEJEYPE)  is 
begin 

BLANK_LINE ( CURRENT_OUTPUT , LINE ) ; 
end  BLANK  JLINE; 

procedure  BLANK_LINE  is 
begin 

BLANK_LINE( CURRENT_OUTPUT , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

package  body  INTEGER_PRINT  is 

procedure  PRINT ( FILE  :  in  FILEJTYPE; 

LINE  s  in  LINEJTYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK)  is 

S  :  STRING (1. .NUM' WIDTH ) ; 

L  ;  NATURAL; 
begin 

PRINT (S,L, ITEM) ; 

PRINT (FILE, LINE, S(l. .L) , BRK ) / 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK)  is 

begin 

PRINT ( FILE, DEFAULTJLINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE JTYPE ; 

ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK)  is 

begin 

PRINT ( CURRENT  JDUTPUT , LINE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK)  is 

begin 

PRINT (CURRENT  J3UTPUT , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 
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#  procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM)  is 

S  :  constant  STRING  NUM' IMAGE( ITEM) ; 

F  :  NATURAL  :«  S' FIRST;  —  Bug  in  DG  Compiler  —  S' FIRST  /-  1  !  !  !  ! 
L  :  NATURAL; 
begin 

if  S(F)  -  '  '  then 

#  F  F  +  1; 
end  if; 

if  TO'LEMGTH  <  S'LAST  -  F  +  1  then 
raise  LAYOUT_ERROR ; 
end  if; 

L  :**  TO' FIRST  +  S'LAST  -  F; 

#  TO(TO' FIRST. .L)  : -  S( F . . S 'LAST ) ; 

LAST  L; 

end  PRINT; 

end  INTEGERJPRINT; 

#  package  body  FLOAT_PRINT  is 

package  NUM_IO  is  new  FLOAT_IO(NUM) ; 
use  NUM_IO; 


procedure  PRINT (FILE  !  in  FILE_TYPE; 

•  LINE  :  in  LINEJEYPE; 

ITEM  :  in  NUM;~ 

BRK  :  in  BREAKJTYPE  BREAK)  is 
S  :  STRING ( 1. . DEFAULT_FORE  +  DEFAULT_AFT  +  DEFAULT_EXP  +  2); 
L  :  NATURAL; 
begin 

•  PRINT( S ,L, ITEM) ; 

PRINT ( FILE, LINF,S(1. . L ) , BRK ) ; 
end  PRINT; 

procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

•  BRK  :  in  BREAK_TYPE  BREAK)  is 
begin 

PRINT ( FILE , DEFAULT_LINE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

•  ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM, BRK )  ; 
end  PRINT; 


procedure  PRINT (ITEM 
BRK 


begin 


in  NUM; 
in  BREAK  TYPE 


BREAK)  is 
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PRINT ( CURRENT_OUTPUT , DEPAULT_L I NE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM)  is 
S  :  STRING ( 1. . DEFAULT_FORE  +  DEFAULT_AFT  +  DEFAULT_EXP  +  2); 

EXP  :  INTEGER; 

E_INDEX  :  NATURAL  S' LAST  -  DEFAULT_EXP ; 

DOT_INDEX  :  NATURAL  DEFAULT_FORE  +  1; 

L  :  NATURAL; 

begin 

PUT (S, ITEM) ; 

EXP  INTEGER' VALUE{S ( E_INDEX+1. .S'LAST)); 

if  EXP  >-  0  then 

if  EXP  <-  DEFAULT_AFT-1  then 

S ( DOT_ INDEX . . DOT_INDEX+EXP- 1 )  : -  S ( DOT_INDEX+ 1 . . DOT_INDEX+EXP ) ; 

S ( DOT_INDEX+EXP )  : -  ' . ' ; 
for  I  in  E_INDEX. .S'LAST  loop 
S(I)  '  ' ; 

end  loop; 
end  if; 

else  —  EXP  <  0 

if  EXP  >-  -  (  DEFAULT_EXP  +  1  )  then 

S ( DEFAULT_EXP+ 2 ..S' LAST )  : -  S ( 1 . . S ' LAST— DEFAULT_EXP- 1 ) ; 
for  I  in  1. ,DEFAULT_EXP+1  loop 
S(I)  '  ' ; 

end  loop; 

E_INDEX  S'LAST  +  1; 

DOT_INDEX  DOT_INDEX  +  DEFAULT_EXP  +  1; 

L  DOT_INDEX+EXP; 
for  I  in  reverse  L+l. . DOT_INDEX  loop 
case  S(I-l)  is 

when  '  '  «>  S(I)  'O'; 

when  ->  S(I-2)  S(I)  'O'; 

when  others  ■>  S(I)  :»  S(I-l); 

end  case; 
end  loop; 

S(L) 

case  S(L-l)  is 

when  '  '  ->  S(L-l)  'O'; 

when  '-'  ->  S(L-2)  S(L-l)  'O'; 

when  others  ->  null; 

end  case; 
end  if; 
end  if; 

for  I  in  reverse  l..E_INDEX-l  loop 

exit  when  S(I)  /■  '0'  or  else  S(I-l)  -  '.'; 

S(I)  '  ' ; 
end  loop; 

L  TO' FIRST  -  1; 
for  I  in  S' RANGE  loop 
if  S(I)  /-  '  '  then 
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L  L  +  1; 

TO(L)  S ( I ) ; 
end  if; 
end  loop; 

LAST  L; 
exception 

when  CONSTRAINT_ERROR  -> 
raise  LAYOUT_ERROR; 
end  PRINT; 

end  FLOAT_PRINT; 

end  TEXT_PRINT; 

3.10.4  package  ORDEFS. ADA 

package  RDBMS_DEFINITIONS  is 


—  Declare  variable  for  reporting  RDBMS  error  number 


RDBMS  ERROR  NUM 


INTEGER; 


—  Declare  exceptions. 


ACCES  S_ERR0R 

BAD_RDBMS_NAME_ERROR 

C0LUMN_ERR0R 

COLUMN_RANGE_ERROR 

CREATE_ERROR 

DB_ALREADY_OPEN_ERROR 

DBCLOSE_ERROR 

DBOPEN_ERROR 

DUPLICATE_KEY_ERROR 

NO_DBOPEN_ERROR 

NO_UPDATE_ERROR 

NO_RETRIEVE_ERROR 

N0_R0W_ERR0R 

NO_TABLE_ERROR 

SYNTAX_ERROR 

TRUNCATE_ERROR 

TYPE_CONVERSION_ERROR 

UNHAND  LED_RDBMS__ERROR 

UNIMPLEMENTED  ERROR 


exception; 
exception; 
exception; 
exception ; 
exception; 
exception; 
exception; 
exception; 
exception; 
exception; 
exception; 
exception ; 
exception; 
exception; 
exception ; 
exception ; 
exception; 
exception; 
exception; 


end  RDBMS_DEFINITIONS ; 
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3.10.5  package  ORCUDEFS. ADA 

with  TEXT_PRINT; 

package  ORACLE_CURSOR_DEFINITIONS  is 

BUFFER_LENGTH  :  constant  INTEGER  : -  4000; 

subtype  BUFFERJTYPE  is  STRING  (1  ..  BUFFER_LENGTH ) ; 

subtype  BUFFER_ACCESS_TYPE  is  TEXT_PRINT . BUFFER_ACCESS_TYPE 

( 1 . . BUFFER_LENGTH ) ; 

RETRIEVAL_BUFFER_LENGTH  :  constant  INTEGER  4000; 

subtype  RETRIEVAL_BUFFER  is  STRING  (1  ..  RETRIEVAL_BUFFER_LENGTH ) ; 

— :**  (others  ->  '  '); 
subtype  RETR I EVAL_LENGTH  is  INTEGER; 

type  FILLER_ARRAY_1  is  array  (1  ..  5)  of  SHORT_INTEGER; 
type  FILLER_ARRAY_2  is  array  (1  ..  25)  of  SHORT_INTEGER; 

—  This  is  the  declaration  of  the  data  area  used  by  Oracle's  HLI. 

—  The  integer  used  should  be  a  16-bit  integer. 

—  The  telesoft  compiler  has  integer  defined  as  a  16-bit  integer. 

—  The  verdix  compiler  has  Short_Integer  defined  as  a  16-bit  integer. 

—  The  DEC  compiler  has  Short_Integer  defined  as  a  16-bit  integer. 

type  DATA_AREA_TYPE  is 
record 

RETURN_CODE  :  SHORT_INTEGER  0; 

FILLER_DATA_1  :  FILLER_ARRAY_1  (0,  0,  0,  0,  0); 

V4_ERR0R_C0DE  :  SHORT_INTEGER  :=  0; 

FILLER_DATA_2  :  FILLER_ARRAY_2  (0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 

0/  0/  0,  0/  0/  0,  Of  Of  Of  Of  Of  Of  0); 

end  record; 

type  CURSOR_DATA_TYPE  is 
record 

ROWID  :  STRING  (1..18)  (1..18  ->  '  '); 

CURSOR_AREA  :  DATA_AREA_TYPE; 
end  record; 

subtype  QUERY_BUFFER_RECORD  is  TEXT_PRINT . QUERY_BUFFER_RECORD  ; 

—  type  QUERY_BUFFER_RECORD  is 

—  record 

QUERY_LENGTH  :  INTEGER  0; 

QUERY_BUF F ER  :  BUFFER_ACCESS_TYPE; 

—  end  record; 

subtype  ACCESS_QUERY_BUFFER  is  TEXT_PRINT . ACCESS_QUERY_BUFFER; 
type  ACCESS_CURSOR_DATA_TYPE  is  access  CURSOR_DATA_TYPE; 
type  CURSOR_ORACLE  is 
record 

CURSOR_DATA  :  ACCESS_CURSOR_DATA_TYPE; 
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CURSOR_QUERY_DATA  :  ACCESS_QUERY_BUFFER; 

CURSOR_COLUMN_NUMBER  :  INTEGER  0; 

CURSOR_MAX_COLUMN  :  INTEGER  0; 

CURSOR_ROW_NUMBER  :  INTEGER  0; 

CURSOR_FIRST_FETCH  :  BOOLEAN  TRUE; 

CURSOR_RETRIEVAL_LEN  :  RETRIEVAL_LENGTH  0; 

CURSOR_RETRIEVAL_BUF  :  RETRIEVAL_BUFFER  (others  ->  '  ' ) ; 

end  record; 

end  ORACLE_CURSOR_DEFINITIONS; 

3.10.6  package  ORHLIS.ADA 

—  This  package  ORACLE_HLI  contains  the  Oracle  HLI  procedures  set  up  as 

—  procedures  for  use  with  the  pragma  interface  so  that  they  can  communicate 

—  to  Oracle. 

With  RDBMS_DEFINITIONS,  SYSTEM,  ORACLE_CURSOR_DEFINITIONS ; 
use  RDBMS_DEFINITIONS,  ORACLE_CURSOR_DEFINITIONS; 

package  ORACLE__HLI  is 

—  Declaration  of  the  Oracle  HLI  subprograms  to  be  called. 

—  These  are  set  up  for  use  with  the  pragma  interface  and 

—  have  the  following  format. 

—  procedure  identifier  ( identif ier_list  :  mode  type_mark); 

—  commit  current  transaction  to  database 
procedure  OCOM  (LDA  ;  in  out  DATA_AREA_TYPE) ; 

—  roll  back  the  current  transaction 
procedure  OROL  (LDA  :  in  out  DATA_AREA_TYPE) ; 

—  establish  communication  between  oracle  and  the  user  program 

procedure  OLON  (LDA  :  in  out  DATA_AREA_TYPE; 

UID  :  in  BUFFER_ACCESS_TYPE; 

UID  :  in  STRING; 

UIDLEN  :  in  SHORT_INTEGER ; 

PSW  :  in  SHORT_INTEGER  -1; 

PSW  :  in  STRING; 

PSWL  :  in  SHORT_INTEGER  :=  -1; 

AUDIT_FLAG  :  in  SHORT_INTEGER  :■=  0); 

—  establishes  a  cursor  to  pass  a  SQL  statement  to  Oracle 
procedure  OOPEN  (CURSOR  :  in  out  DAT A_AREA_T YP E ; 

LDA  :  in  out  DATA_AREA_TYPE ; 

DBN  :  in  SHORT_INTEGER  -1; 

DBNLEN  :  in  SHORT_INTEGER  -1; 
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AREASIZE  :  in  SHORT_INTEGER  -1; 

UID  :  in  SHORT_INTEGER  -1; 

UIDLEN  :  in  SHORT~INTEGER  -1)/ 

—  associated  a  SQL  statement  with  a  cursor  and  passes  the  SQL  statement  to 

—  oracle 

procedure  0SQL3  (CURSOR  :  in  out  DATA_AREA_T YPB ; 

SQLSTATEMENT  :  in  BUFFER_ACCESS_TYPE; 

SQLSTATEMENT  :  in  STRING; 

SQLLEN  :  in  SHORT_INTEGER) ; 


—  causes  the  SQL  statement  currently  associated  with  a  cursor  to  be  processed 
procedure  OEXEC  (CURSOR  :  in  out  DATA_AREA_TYPE) ; 


— defines  an  output  buffer 
procedure  ODEFIN  (CURSOR 
POS 

BUFFER 

BUFL 

FTYPE 

SCALE 

INDP 

FMT 

FMTL 

FMTT 

RETL 

RCODE 


for  each  field  in  a  select-list  in  the  SQL  query 
:  in  out  DAT A_AREA_TYP E ; 

:  in  SHORT_INTEGER; 

:  in  SYSTEM . ADDRESS ; 

:  in  SHORT_INTEGER; 

:  in  SHORT_INTEGER; 

:  in  SHORT_INTEGER  -1; 
s  in  SHORT_INTEGER  -1; 

:  in  SHORT_INTEGER  :•  -1; 

:  in  SHORT_INTEGER  :•  -1; 

:  in  SHORT~INTEGER  : -  -1; 

:  in  SHORT~INTEGER  -1; 

:  in  SHORT_INTEGER  -1); 


— returns 


internal  datatype  and 


size  information  for  a  field  or  expression 


—  in  the  select_list  of  a  query 


procedure  ODSC  (CURSOR 

in  out  DATA_AREA_TYPE; 

POSITION 

in  SHORT_INTEGER; 

DBSIZE 

in  SHORT_INTEGER 

-  -1 

FSIZE 

in  SHORT_INTEGER 

-  -1 

RCODE 

in  SHORT_INTEGER 

-  -1 

D8TYPE 

in  SHORT_INTEGER 

-  -1 

CBUF 

in  SHORT_INTEGER 

-  -1 

CBUFL 

in  SHORT_INTEGER 

-  -1 

DSIZE 

out  SHORT_INTEGER ) ; 

—  retrieve  the  names  of  the  columns  in  a  select_list  of  a  SOL  query 


procedure  ONAME 


(CURSOR 

POSITION 

TBUF 

TBUF1 

CBUF 

CBUF1 


in  out  DATA_AREA_TYPE ; 
in  SHORT_INTEGER ; 
in  SHORT_INTEGER; 
in  SHORT_INTEGER ; 
in  SYSTEM. ADDRESS ; 
in  SYSTEM . ADDRESS ) ; 


—  returns  one  row  of  a  query  result 

procedure  OFETCH  (CURSOR  :  in  out  DATA_AREA_TYPE ) ; 
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—  disconnects  a  cursor  from  oracle 

procedure  OCLOSE  (CURSOR  :  in  out  DATA_AREA_TYPE) ; 

— disconnects  a  program  from  oracle 

procedure  OLOGOF  (LDA  :  in  out  DATA_AREA_TYPE ) ; 


private 

—  pragma  interface  (language_name,identif ier) / 
pragma  INTERFACE  (C,  OCOM) ; 

pragma  IMPORTJPROCEDURE  (OCOM,  OCOM,  ( DATA_AREA_TYPE ) , 

MECHANISM  ->  (REFERENCE)); 

pragma  INTERFACE  (C,  OROL); 

pragma  IMPORT_PROCEDURE  (OROL,  OROL,  ( DATA_AREA _TYPE ) , 

MECHANISM  ->  (REFERENCE)); 

pragma  INTERFACE  (C,  OLON) ; 

—  pragma  IMPORT_PROCEDURE  (OLON,  OLON,  ( DATA_AREA_TYPE , 

BUFFER_ACCESS_TYPE , 

pragma  IMPORT_PROCEDURE  (OLON,  OLON,  (DATA_AREA_TYPE,  STRING, 

SHORTJCNTEGER,  SHORT_INTEGER ,  SHORT_INTEGER, 
SHORT_INTEGER ,  STRING,  SHORT_INTEGER, 

SHORT_INTEGER ) ,  MECHANISM  ->  (REFERENCE,  VALUE, 
SHORT_INTEGER) ,  MECHANISM  ->  (REFERENCE,  REFERENCE, 
VALUE,  REFERENCE,  VALUE,  VALUE)); 

VALUE,  VALUE,  VALUE,  VALUE)); 

pragma  INTERFACE  (C,  OOPEN); 

pragma  IMPORT_PROCEDURE  (OOPEN,  OOPEN,  ( DATA_AREA_TYPE , 

D AT A_AREA_T YP  E , 

SHORT_INTEGER ,  SHORT_INTEGER ,  SHORT_INTEGER , 
SHORT_INTEGER,  SHORT_INTEGER) ,  MECHANISM  -> 
(REFERENCE,  REFERENCE,  VALUE,  VALUE,  VALUE,  VALUE, 
VALUE)); 

pragma  INTERFACE  (C,  OSQL3); 

—  pragma  IMPORT_PROCEDURE  ( OSQL3 ,  0SQL3,  (DATA_AREA_TYPE, 

BUFFER_ACCESS_TYPE , 

pragma  IMPORT_PROCEDURE  (OSQL3,  0SQL3,  (DATA_AREA_TYPE,  STRING, 

SHORT_INTEGER) ,  MECHANISM  -> 

(REFERENCE,  VALUE,  VALUE))) 

(REFERENCE,  REFERENCE,  VALUE)); 

pragma  INTERFACE  (C,  ODEFIN); 

pragma  IMPORT_PROCEDURE  (ODEFIN,  ODEFIN,  ( DATA_AREA_TYPE , 

SHORT_INTEGER, 

SYSTEM. ADDRESS,  SHORT_INTEGER,  SHORT_INTEGER , 
SHORT_INTEGER ,  SHORT_INTEGER,  SHORT_ INTEGER, 
SHORT_INTEGER,  SHORT_INTEGER ,  SHORT_INTEGER, 
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SHORT_INTEGER) ,  MECHANISM  ->  (REFERENCE,  VALUE, 
VALUE,  VALUE,  VALUE,  VALUE,  VALUE,  VALUE, 

VALUE,  VALUE,  VALUE,  VALUE)); 

pragma  INTERFACE  (C,  ODSC); 

pragma  IMPORT_PROCEDURE  (ODSC,  ODSC,  (DATA_AREA_TYPE,  SHORT_INTEGER , 

SHORT_INTEGER ,  SHORT_INTEGER ,  SHORT_INTEGER , 
SHORT_INTEGER,  SHORT_INTEGER ,  SHORT_INTEGER , 
SHORT_INTEGER) ,  MECHANISM  ->  (REFERENCE,  VALUE, 
VALUE,  VALUE,  VALUE,  VALUE,  VALUE,  VALUE, 
REFERENCE)); 

pragma  INTERFACE  (C,  ONAME); 

pragma  IMPORT_PRoCEDURE  (ONAME,  ONAME,  ( DATA_AREA_TYPE ,  SHORT_INTEGER , 

SHORT_INTEGER ,  SHORT_INTEGER ,  SYSTEM. ADDRESS, 
SYSTEM. ADDRESS ) ,  MECHANISM  ->  (REFERENCE,  VALUE, 
VALUE,  VALUE,  VALUE,  VALUE)); 

pragma  INTERFACE  (C,  OEXEC); 

pragma  IMPORT_PROCEDURE  (OEXEC,  OEXEC,  ( DAT A_AREA_TYP E ) , 

MECHANISM  ->  REFERENCE); 


pragma  INTERFACE  (C,  OFETCH) ; 

pragma  IMPORT JPROCEDURE  (OFETCH,  OFETCH,  (DATA_AREA_TYPE) , 

MECHANISM  ->  REFERENCE) ;  ~  ' 

pragma  INTERFACE  (C,  OCLOSE) ; 

pragma  IMPORT_PROCEDURE  (OCLOSE,  OCLOSE,  (DATA_AREA_TYPE) , 

MECHANISM  ->  REFERENCE); 

pragma  INTERFACE  (C,  OLOGOF);  1 

pragma  IMPORT_PROCEDURE  (OLOGOF,  OLOGOF,  ( DATA_AREA_TYPE ) , 

MECHANISM  ->  REFERENCE); 

end  ORACLE_HLI; 

< 

3.10.7  package  ORINTS. ADA 

—  package  RDBMS_INTERFACE  contains  the  procedures  utilized  by  the  user  query 

—  generation  function  to  communicate  to  the  oracle  RDBMS. 


with  RDBMS_DEFINITIONS,  ORACLE_HLI ,  ORACLE_CURSOR_DEFINITIONS ; 
use  RDBMS_DEFINITIONS ,  ORACLE_HLI ,  ORACLE_CURSOR_DEFINITIONS; 


package  RDBMS_INTERFACE  is 


subtype  CURSOR_TYPE  is  CURSOR_DATA_TYPE ; 


( 


CURS 0R_D AT A_AREA  :  CURSOR_DATA_TYPE ; 
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type  COLUMN JTXPE  is 
record 

COLUMN_NAME  :  STRING  (1..18)  (1..18  ->  ' 

COLUMN_NAME_LENGTH  :  INTEGER  0; 
end  record; 

type  COLUMN_NAMES_TYPE  is  ARRAY  (1..127)  of  COLUMNJTYPE 

—  reap  the  user's  data  from  ARI's  retrieval  buffer, 
procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  STRING; 

VAR_LEN  :  out  INTEGER; 

RETRIEVAL_LEN  :  in  RETRIEVAL_LENGTH ; 
RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER) ; 

—  reap  the  user's  data  from  ARI's  retrieval  buffer, 
procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  i  in  INTEGER; 

VAR  •.  out  CHARACTER; 

RETRIEVAL_LEN  s  in  RETRIEVAL_LENGTH; 
RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER) ; 

—  reap  the  user's  data  from  ARI's  retrieval  buffer, 
procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  INTEGER; 

RETRIEVAL_LEN  :  in  RETRI EVAL_LENGTH ; 
RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER) ; 

—  reap  the  user's  data  from  ARI's  retrieval  buffer, 
procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  FLOAT; 

RETRIEVAL_LEN  :  in  RETRIEVAL_LENGTH ; 
RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER) ; 

—  executes  a  query  on  a  RDBMS, 
procedure  RDBMS_EX£CUTE 

(CURSOR  :  in  out  DATA_AREA_TYPE) ; 

—  logs  the  user  off  an  RDBMS, 
procedure  RDBMS_EXIT_DATABASE ; 

—  close  a  cursor 
procedure  RDBMS_CLOSE_CURSOR 

(CURSOR  :  in  out  DATA_AREA_TYPE) ; 

—  fetches  data  from  an  RDBMS  after  a  retrieve  query, 
procedure  RDBMS_FETCH 

(CURSOR  :  in  out  CURS0R_0RACLE) ; 
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—  logs  the  user  into  an  RDBMS. 

— procedure  RDBMS_OPEN_DATABASE 

—  (QUERY_BUFFER  :  in  BUFFER_ACCESS_TYPE; 

QUERY_LENGTH  :  in  INTEGER) ; 
procedure  RDBMS_OPEN_DATABASE 

(QUERY_BUFFER  :  in  BUFFER_ACCESS_TYPE; 

QUERY_LENGTH  :  in  INTEGER; 

QUERYX_BUFFER  :  in  BUFFER_ACCESS_TYPE ; 

QUERYX_LENGTH  :  in  INTEGER); 

—  opens  a  cursor  for  the  database 
procedure  RDBMS_OPEN_CURSOR 

(CURSOR  :  in  out  DATA_AREA_TYPE ) ; 

—  commit  work  for  transaction, 
procedure  RDBMS_COMMIT_WORK ; 

—  rollback  work  for  transaction, 
procedure  RDBMS_ROLLBACK_WORK; 

—  retrieve  column  names  used  in  SELECT 
procedure  RDBMS_ONAME 

(CURSOR  :  in  out  D AT A_AREA_T YP E ; 

NAMES  :  in  out  COLUMN_NAMES_TYPE ; 

NUMBER_OF_NAMES  :  out  INTEGER); 

—  sends  a  query  to  an  RDBMS, 
procedure  RDBMS_QUERY 

(QUERY_BUFFER  :  in  out  BUFFER_ACCESS_TYPE; 

QUERY  LENGTH  i  in  INTEGER; 

in  out  DATA_AREA_TYPE ) ; 

exception  renames  RDBMS_DEFINITIONS . ACCESS_ERROR; 
exception  renames 

RDBMS_DEFINITIONS . BAD_RDBMS_NAME_ERROR; 
exception  renames  RDBMS_DEFINITIONS.COLUMN_ERROR; 
exception  renames 

RDBMS_DEFINITIONS . COLUMN_RANGE_ERROR ; 
exception  renames 

RDBMS_DEFINITIONS . DB_ALREADY_OPEN_ERROR; 
exception  renames  RDBMS_DEFINITIONS . DBCLOSE_ERROR; 
exception  renames  RDBMS_DEFINITIONS.DBOPEN_ERROR; 
exception  renames 

RDBMS_DEFINITIONS . DUPLICATE_KEY_ERROR; 
exception  renames  RDBMS_DEFINITIONS.NO_DBOPEN_ERROR; 
exception  reneunes 

RDBMS_DEFINITIONS . NO_RETRIEVE_ERROR; 
exception  renames  RDBMS_DEFINITIONS.NO_ROW_ERROR; 
exception  renames  RDBMS_DEFINITIONS . NO_TABLE_ERROR; 
exception  renames  RDBMS_DEFINITIONS . SYNT AX_ERROR ; 
exception  renames  RDBMS_DEFINITIONS.TRUNCATE_ERROR; 


CURSOR 

ACCES  S_ERROR  : 

BAD_RDBMS_NAME_ERROR 

COLUMN__ERROR 
COLUMN_RANGE_ERROR  : 

DB_ALREADY_OPEN_ERROR  : 

DBCLOSE_ERROR 
DBOPEN__ERROR  : 

DUPLICATE_KEY_ERROR 

NO_DBOPEN_ERROR  : 

NO_RETRIEVE_ERROR 

NO_ROW_ERROR  : 

NO_TABLE_ERROR 
SYNTAX_ERROR 
TRUNCATE  ERROR 
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TYPE_CONVERSION_ERROR  :  exception  renames 

RDBMS_DEFINITIONS . TYPE_CONVERSION_ERROR ; 

UNHAND LED_RDBMS_ERROR  :  exception  renames 

RDBMS_DEFINITIONS . UNHAND LED_RDBMS_ERROR ; 

UNIMP LEMENTED_ERROR  :  exception  renames 

RDBMS_DEFINITIONS . UNIMPLEMENTED_ERROR / 
N0_UPDATE_ERR0R  :  exception  renames 

RDBMSJDEFINITIONS . NO_UPDATE_ERROR ; 

end  RDBMS_INTERFACE; 

3.10.8  package  FUNCTIONS  .ADA 

with  0RACLE_CURS0R_DEFINITI0NS,  DATABASE,  RDBMS_DEFINITI0NS; 
use  ORACLE_CURSOR_DEFINITIONS; 

package  ADA_SQL_FUNCTIONS  is 

NO_UPDATE_ERROR  :  exception  renames  RDBMS_DEFINITIONS.NO_UPDATEJERROR; 
NOT_FOUND_ERROR  :  exception  renames  RDBMS_DEFINITIONS.NO_ROW_ERROR; 
INTERNAL__ERROR  :  exception; 

UNIQUE_ERROR  :  exception; 

WANNA_DEBUG  i  BOOLEAN  :«  FALSE; 


rpe  SQL  OPERATION  is 
0_AVG 

9 

0_MAX 

9 

0_MIN 

9 

0_SUM 

0_UNARY_PLUS 

f 

0_UNARY_MINUS 

f 

0_PLUS 

9 

0_MINUS 

0_TIMES 

9 

0_DIVIDE 

9 

0_EQ 

9 

0_NE 

0_LT 

9 

0_GT 

9 

0_LE 

9 

0_GE 

0_BETWEEN 

9 

0_AND 

9 

0_IS_IN 

9 

0_0R 

0_N0T 

9 

0_LIKE 

9 

0_AMP  ERS AND 

9 

0_SELEC 

0_SELECT_DISTINCT 

/ 

oIasc 

9 

0_DESC 

9 

0_TABLE_C0LUMN_LI ST 

0_C0UNT_STAR 

t 

O_NULL_0P 

f 

0_STAR 

f 

0_N0T_IN 

0_VALUES 

9 

0_DECLAR  ); 

type  SQL_OBJECT  is  private; 

type  TYPED_SQL_OBJECT  is  private; 

type  TABLE_NAME  is  private; 

type  TABLE_LIST  is  private; 

type  INSERT_ITEM  is  private; 

type  CURSOR_NAME  is  private; 

type  DATABASE_NAME  is  private; 

NULL_SQL_OBJECT  :  constant  SQL_OBJECT; 

procedure  INITIATE_TEST ;  —  *****  ONLY  FOR  TESTING 

—  constant  literal  value  generator 

generic 
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type  RESULTJTYPE  is  private; 

VALUE  :  in  RESULT_TYPE; 
function  CON  ST ANT_LITERAL  return  RESULT_TYPE ; 

conversion  routines  for  SQL  objects 

function  L_CONVERT  {  L  :  TYPED_SQL_OBJECT  )  return  SQL_OB JECT ; 

function  R_CONVERT  (  R  :  TYPED__SQL_OBJECT  )  return  SQL_OBJECT 
renames  L_CONVERT ; 

function  CONVERT_R  <  R  :  SQL _0B JECT  )  return  TYPED_SQL_OB JECT ; 
package  CONVERT  is 

function  L_CONVERT  (  L  :  SQL_OBJECT  )  return  SQL_OBJECT; 

function  RECONVERT  (  R  :  SQL_OBJECT  )  return  SQL_OBJECT  renames  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  SQL_OBJECT  renames  L__CONVERT ; 

function  L_CONVERT  (  L  :  TABLE_NAME  )  return  SQL_OBJECT; 

function  R_CONVERT  (  R  :  TABLE_NAME  )  return  SQL_OBJECT  renames  L_CONVERT / 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TABLE_NAME; 

function  L_CONVERT  (  L  :  TABLE_LIST  )  return  SQL_OBJECT; 

function  CONVERT_R  (  R  :  SQL„OBJECT  )  return  TABLE_LIST; 

function  L_CONVERT  (  L  :  INSERT_ITEM  )  return  SQL_OBJECT; 
function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  INSERT_ITEM; 
end  CONVERT; 

-  conversion  routines  for  user  types 
—  *****  instantiate  these  as  L_CONVERT,  then  rename  as  R_CONVERT 
generic 

type  USER_TYPE  is  (<>); 

function  INTEGER_AND_ENUMERATION_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT; 

generic 

type  USER_TYPE  is  digits  <>; 

function  FLOAT_CONVERT  (  VAR  :  USER_TYPE  )  return  SQL_OBJECT; 
generic 


28 

UNCLASSIFIED 


UNCLASSIFIED 


type  INDEXJTYPE  is  range  <>; 

type  USERJTYPE  is  array  (  INDEXJTYPE  range  <>  )  of  CHARACTER; 
function  UNCONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT ; 

generic 

type  INDEXJTYPE  is  range  <>; 

type  USERJTYPE  is  array  (  INDEXJTYPE  )  of  CHARACTER; 
function  CONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OB JECT ; 

generic 

type  I NDEX_T YP E  is  range  <>; 
type  COMPONENT JTYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJTYPE  range  <>  )  of  COMPONENT  JTYPE ; 
with  function  CONVERT_COMPONENT_TO_CHARACTER  (  C  :  COMPONENT  JTYPE  ) 
return  CHARACTER  is  <>; 

function  UNCONSTRAINED_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQLOB JECT ; 

—  *****  must  generate  CONVERT_COMPONENT_TO_CHARACTER 


generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENT  JTYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJTYPE  )  of  COMPONENT  JTYPE; 
with  function  CONVERT_COMPONENT_TO_CHARACTER  (  C  :  COMPONENT_TYPE  ) 
return  CHARACTER  is  <>; 

function  CONSTRAINED_STRING_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT; 

—  column  and  table  name  routines 

generic 

GIVEN_NAME  :  in  STANDARD . STRING ; 
package  NAME_PACKAGE  is 

generic 

type  SQL_OBJECT_TYPE  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  SQL_OB JECT  JTYPE  is  <>; 
function  COLUMN_OR_TABLE_NAME  return  SQL_OB JECT_TYPE ; 

generic 

function  T ABLE_NAME_WITH_COLUMN_L I ST  (  COLUMNS  :  SQL_OBJECT  ) 
return  TABLE_NAME; 

end  NAME_PACKAGE; 

—  *****  must  generate  routines  for  table. column  (define  record  structure) 

—  *****  must  generate  package  for  correlation. column  and  correlation. table 
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—  value  specification  routines 
generic 

type  USER_TYPE  is  private; 
type  RESULT JEYPE  is  private; 

with  function  L_CONVERT  (  L  :  USER_TYPE  )  return  SQL_OBJECT  is  <>; 
with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  RE S ULT_TYP E  is  <>; 
function  INDICATOR_FUNCTION  (  VAL  :  USERJEYPE  )  return  RESULT_TYPE; 

—  generic  operation  routines 
generic 

GIVEN_OPERATION  :  in  SQL_OPERAT I ON ; 
type  L_TYPE  is  private; 
type  TYPE_R  is  private; 

with  function  L_CONVERT  (  L  :  L_TYPE  )  return  SQL_OBJECT  is  <>; 
with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  UNARY_OP ERAT ION  (  L  :  L_TYPE  )  return  TYPE_R ; 

generic 

GIVEN_OPERATION  :  in  SQL_OPERATION; 
type  L_TYPE  is  private; 
type  R_TYPE  is  private; 
type  TYPE_R  is  private; 

with  function  L_CONVERT  (  L  :  L_TYPE  )  return  SQL_OBJECT  is  <>; 

with  function  R_CONVERT  (  R  :  R_TYPE  )  return  SQL_OBJECT  is  <>; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 

function  BINARY_OPERATION  (  L  ;  L_TYPE  ;  R  :  R_TYPE  )  return  TYPE_R; 

—  set  function  routines 

—  *****  must  also  generate  STAR_TYPE  is  ' ;  function  COUNT  (  STAR_TYPE  ) 

—  *****  instantiate  COUNT_STAR  for  DATABASE. INT  or  untyped 

generic 

type  TYPE_R  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  COUNT_STAR  return  TYPE_R; 

—  instantiate  UN ARY_OPERAT I ON  for  0_AVGf  0_MAX,  0_MIN,  0_SUM 

—  value  expression  routines 

—  instantiate  UNARY_OPERAT ION  for  0_UNARY_PLUS ,  0_UNARY_MINUS 

—  instantiate  BINARY_OPERATION  for  0_PLUS,  0_MINUS,  0_TIMES,  0_DIVIDE 

—  *****  generate  CONVERT_TO  package  for  type  conversions,  calling  CONVERT_R 

—  to  set  correct  result  type 

—  comparison  predicate  routines 
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—  instantiate  BINARY_OPERATION  for  0_EQ,  0_NE,  0_LT,  0_GT,  0_LE,  0_GE 
between  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_BETWEEN 

—  instantiate  BINARY_OPERATION  for  0_AND 
in  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_IS_IN 

—  special  case  if  <in  value  list>  has  one  element 

—  instantiate  B INARY_OPERAT I ON  for  0_0R 

—  different  instantiations  for  first  and  following  ORs 

—  instantiate  UN ARY_0 P ERAT ION  for  0_N0T 
like  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_LIXE 

—  instantiate  UNARY_OP ERAT ION  for  0_N0T 
search  condition  routines 

—  instantiate  BINARY_OPERATION  for  0_AND,  0_0R 

—  instantiate  UNARY_OPERAT ION  for  0_N0T 
from  clause  routines 

—  instantiate  BINARY_OPERATION  for  0__AMPERSAND 
group  by  clause  routines 

—  instantiate  B INARY_OPERAT ION  for  0_AMPERSAND 
subquery  routines 

generic 

SELECTJIYPE  :  in  SQL_OPERAT ION ; 

type  WHAT_TYPE  is  private; 

type  TYPE_R  is  private; 

with  function  L_CONVERT  (  L  :  WHAT_TYPE  )  return  SQL_OBJECT  is  <>; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 

function  SELECT_LIST_SUBQUERY 

(  WHAT  :  WHATJTYPE; 

FROM  :  TABLE_LIST; 
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WHERE  :  SQL JDB JECT  NULL_SQLJDB JECT ; 

GROUP_BY  :  SQLJDBJECT  NULL_SQL JDB JECT ; 

HAVING  :  SQLJDBJECT  NULL_SQL_OBJECT  )  return  TYPE_R 

generic 

SELECT JTYPE  :  in  SQLJDPERATION; 
type  TYPEJt  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  STAR_SUBQUERY 

(  PROM  :  TABLE_LI ST ; 

WHERE  :  SQL_OBJECT  NULL_SQL JDB JECT ; 

GROUP_BY  :  SQL_OBJECT  : »  NULL_SQL JDB JECT ; 

HAVING  :  SQLJDBJECT  NULL_SQL_OBJECT  )  return  TYPE_R 

—  query  specification  routines 

—  instantiate  appropriate  subquery  routines 

—  also  instantiate  BINARY JDPERATION  for  0_ AMP ER S AND 

—  close  routine 

procedure  CLOSE  (  CURSOR  ;  in  out  CURSOR_NAME  ) ; 

—  declare  cursor  routines 
procedure  DECLAR 

(  CURSOR  :  in  out  CURSORJNAME ; 

CURSOR_FOR  :  in  SQLJDBJECT; 

ORDER_BY  :  in  SQL_OBJECT  NULL_SQL_OBJECT  ); 

procedure  DECLAR 

(  CURSOR  :  in  out  CURSOR_NAME; 

CURSOR_FOR  :  in  SQLJDBJECT; 

ORDER_BY  :  in  DATABASE . COLUMN  JIUMBER  ) ; 

—  instantiate  BINARY_OPERATION  for  0_AMPERSAND 

—  instantiate  UNARY_0PERATI0N  for  0_ASC  and  0_DESC 

—  delete  routines 

procedure  DELETE_FROM 

(  TABLE  :  in  TABLE JJAME ; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OBJECT  ); 

—  fetch  and  into  routines 

procedure  FETCH  (  CURSOR  :  in  out  CURSOR_NAME  ) ; 
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generic 

type  USERJTYPE  is  (<>); 
procedure  INTEGER_AND_ENUMERATION_INTO 
(VAR  :  out  USERJTYPE) ; 


generic 

type  USERJTYPE  is  digits  <>; 
procedure  FLOAT_INTO 

(VAR  :  out  USERJTYPE); 


generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENT  JTYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJIYPE  range  <> 


with  function  CONVERT_CHARACTERJTO_COMPONENT 
(C  :  CHARACTER) 
return  COMPONENT JTYPE  is  <>; 
procedure  UNCONSTRAINED_STRING_INTO 
(VAR  !  out  USERJTYPE; 

LAST  :  out  INDEX  JTYPE); 


of  COMPONENT  TYPE; 


generic 

type  INDEX_TYPE  is  range  <>; 
type  COMPONENT_TYPE  is  (<>); 

type  USER_TYPE  is  array  (  INDEX  JTYPE  )  of  COMPONENT  JTYPE ; 
with  function  CONVERT_CHARACTER_TO_COMPONENT 
(C  :  CHARACTER) 


return  COMPONENT  JTYPE  is  <>; 
procedure  CONSTRAINED_STRING_INTO 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEX  JTYPE); 


-  insert  into  routines 

procedure  INSERT_INTO 

(  TABLE  :  in  TABLE_NAME; 

WHAT  :  in  INSERT_ITEM  ); 

—  instantiate  BINARY_OPERAT ION  for  0__AMPERSAND 

—  see  table  name  routines  for  table  (  column  list  ) 
function  VALUES  return  INSERT_ITEM; 

—  instantiate  BINARY_OPERATION  for  0_LE  and  0_AND 

-  open  routine 

procedure  OPEN  (  CURSOR  :  in  out  C UR SOR_NAME  ) ; 
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—  select  statement  routines 

—  see  above  for  fetch  and  Into  routines 
generic 

SELECT  _TYPE  :  in  SQL_OPERAT I ON / 
type  WHAT__TYPE  is  private; 

with  function  L_CONVERT  (  L  :  WHAT_TYPE  )  return  SQL_OBJECT  is  <> 
procedure  SELECT_LIST_SELECT 

(  WHAT  :  in  WHAT_TYPE; 

PROM  :  in  TABLE_LIST; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OB JECT ; 

GROUP_BY  :  in  SQL_OBJECT  :»  NULL_SQL_OB JECT ; 

HAVING  :  in  SQL_OBJECT  NULL_SQL_OBJECT  ); 

generic 

SELECTJTYPE  :  in  SQL_OPERATION; 
procedure  STAR_SELECT 

(  FROM  :  in  TABLE_L 1ST; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OB JECT ; 

GROUP_BY  :  in  SQL_OBJECT  :  =  NULL_SQL_OB JECT ; 

HAVING  :  in  SQL_OBJECT  NULL_SQL_OBJECT  ); 

—  update  routines 

procedure  UPDATE 

(  TABLE  :  in  TABLE_NAME; 

SET  :  in  SQL_OBJECT; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OBJECT  ) ; 

procedure  OPEN__DATABASE 

(DATABASE_NAME  :  in  STRING; 

PASSWORD  :  in  STRING); 

procedure  EXIT_DATABASE ; 

—  instantiate  BINARY_OPERATION  for  0_AND 

—  instantiate  BINARY_OPERATION  for  0_LE 
private 

type  DATABASE_NAME  is  access  STANDARD . STRING ; 
type  ACCESS_STRING  is  access  STANDARD . STRING ; 

type  SQL_VALUE_KIND  is  (  INTEGER  ,  FLOAT  ,  STRING  ); 

type  SQL_VALUE  (  KIND  :  SQL_VALUE_K IND  :=  INTEGER  )  is 
record 

case  KIND  is 

when  INTEGER  »> 
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INTEGER  :  DATABASE . INT ; 
when  FLOAT  =*> 

FLOAT  :  DATABASE. DOUBLE_PRECISION; 
when  STRING  •> 

STRING  :  ACCESS_STRING; 
end  case; 
end  record; 

type  SQL_OBJECT_KIND  is  (  NAME  ,  VALUE  ,  OPERATION  ); 

type  SQL_OBJECT_RECORD  (  KIND  :  SQL_OBJECT_KIND  ); 
type  TYPED_SQL_OBJECT  is  access  SQL_OB JECT_RECORD ; 
type  SQL_OBJECT  is  new  TYPED_SQL_OB JECT ; 
type  TABLE_NAME  is  new  TYPED_SQL_OB JECT ; 
type  TABLE_LIST  is  new  TYPED_SQL_OB JECT ; 
type  INSERT_ITEM  is  new  TYPED_SQL_OB JECT ; 

type  SQL_OBJECT_RECORD  (  KIND  s  SQL_OBJECT_KIND  )  is 
record 

ACROSS  :  SQL_OB JECT ; 
case  KIND  is 
when  NAME  ■  > 

NAME  :  DAT AB ASE_NAME ; 
when  VALUE  -> 

VALUE  :  SQL_VALUE; 
when  OPERATION  -> 

OPERATION  i  SQL_OPERATION; 

OPERANDS  !  SQL_OB JECT ; 
end  case; 
end  record; 

NULL_SQL_OBJECT  :  constant  SQL_OBJECT  null; 

type  CURSOR_NAME_RECORD  is 
record 

CURSOR_OBJECT  :  SQL_OBJECT; 

CURSOR_RDBMS  :  CURSOR_ORACLE ; 

end  record; 

type  CURSOR_NAME  is  access  CURSOR_NAME_RECORD; 

end  ADA_SQL_FUNCTIONS; 

— with  ADA_SQL_FUNCT IONS ; 

— package  CURSOR_DEFINITION  is 

—  subtype  CURSOR_NAME  is  ADA_SQL_FUNCTIONS . CURSOR_NAME; 

— end  CURSOR_DEFINITION; 

3.10.9  package  ORINTB.ADA 

—  package  RDBMS_INTERFACE  contains  the  procedures  utilized  by  the  user  query 


35 

UNCLASSIFIED 


UNCLASSIFIED 


—  generation  function  to  communicate  to  the  Oracle  RDBMS. 

With  TEXT_IO,  SYSTEM,  UNCHECKED_DEALLOCAT ION ; 
use  TEXT_IO,  SYSTEM; 

package  body  RDBMS_INTERFACE  is 


DB_OPEN_FLAG  :  BOOLEAN  FALSE;  —  indicates  if  a  database  is  open 
LOGON_DATA_AREA  :  DAT A_AREA_T YP  E ; 

— FIRST_FETCH  :  BOOLEAN  :«  FALSE; 

function  STRING_TO_INTEGER 
(STR  :  in  STRING) 
return  INTEGER; 
function  STRING_TO_FLOAT 
(STR  :  in  STRING) 
return  FLOAT; 

procedure  FREE  is  new  UNCHECKED_DEAL LOCATION 

( BUFFER_TYPE ,  BUFFER_ACCESS_TYPE) ; 


—  RDBMS_COLUMN_REAPER  -  extraction  of  a  string  column  from  the  retrieval 

—  buffer. 

procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  STRING; 

VAR_LEN  :  out  INTEGER; 

RETRIEVAL_LEN  :  in  RETRIEVAL_LENGTH ; 

RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER)  is 

COLUMN_COUNTER  :  INTEGER; 

COLUMN_START  :  INTEGER; 

COLUMN_END  :  INTEGER; 

begin 

COLUMN_COUNTER  :**  0; 

COLUMN_START  1; 

COLUMN_END  COLUMN_START ; 

VAR_LEN  0; 
loop 

if  COLUMN_END  >  RETRIEVAL_LEN  then 
raise  COLUMN_RANGE_ERROR ; 
end  if; 

if  RETRIEVAL_BUF  (COLUMN_END)  -  ' | '  then 
C0LUMN_C0UNTER  COLUMN_COUNTER  +  1; 
end  if; 

if  COLUMN_COUNTER  -  COLUMN_NUMBER  then 

if  VAR' LAST  -  VAR' FIRST  +  1  <  COLUMN_END  -  COLUMN_START  then 
VAR  (VAR' FIRST  ..  VAR' LAST)  RETRIEVAL_BUF 
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< COLUMN_START  ..  COLUMN_START  +  VAR' LAST  -  VAR' FIRST); 
VARJLEN  VAR 'LAST  -  VAR 'FIRST  +  1; 
raise  TRUNCATEJERROR; 
else 

VAR  (VAR' FIRST  ..  VAR' FIRST  +  C0LUMNJ5ND  -  COLUMN_START  -  1)  :» 

RETRIEVAL_BUF  ( COLUMN_START  ..  COLUMN_END  -  1); 

VAR_LEN  (VAR' FIRST  +  COLUMN_END  -  COLUMN_START  -  1)  - 
VAR' FIRST  +  jl; 

end  if; 
exit; 

elsif  RETRI EVAL_BUF  ( COLUMN_END )  =  ' | '  then 
COLUMN_START  COLUMN_END  +  1; 

COLUMN_END  :=  COLUMN_START ; 
else 

COLUMN_END  :=  COLUMN_END  +  1; 
end  if; 
end  loop; 

end  RDBMS_COLUMN_REAPER ; 


RDBMS_COLUMN_REAPER  -  extraction  of  a  character  column  from  the  retrieval 
buffer. 

procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  CHARACTER; 

RETRIEVAL_LEN  :  in  RETRIEVAL_LENGTH ; 

RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER)  is 


COLUMN_COUNTER  :  INTEGER; 
COLUMN_START  :  INTEGER; 
COLUMN_END  .•  INTEGER; 


begin 

COLUMN_COUNTER  0; 

COLUMN_START  1; 

COLUMN_END  COLUMN_START ; 

loop 

if  COLUMN_END  >  RETRIEVAL_LEN  then 
raise  COLUMN_RANGE_ERROR ; 

end  if; 

if  RETRIEVAL_BUF  (COLUMN_END)  -  ' | '  then 
COLUMN_COUNTER  :=»  COLUMN_COUNTER  +  1;  . 

end  if; 

if  C0LUMN_C0UNTER  -  COLUMN_NUMBER  then 
if  COLUMN_END  -  COLUMN_START  >  1  then 
VAR  RETRIEVAL_BUF  ( COLUMN_START ) ; 
raise  TRUNCATE_ERROR ; 
else 

VAR  RETRIEVAL_BUF  ( COLUMN_START ) ; 
end  if; 
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exit; 

elsif  RETRIEVAL_BUF  (COLUMN_END)  -  '  |  '  then 
COLUMN_START  COLUMN_END  +  1; 

COLUMN_END  COLUMN_START ; 

else 

COLUMN_END  s-  COLUMN__END  +  1; 
end  if; 
end  loop; 

end  RDBMS_COLUMN_REAPER ; 


RDBMS_COLUMN_REAPER  -  extraction  of  an  integer  column  from  the  retrieval 
buffer. 

procedure  RDBMS_COLUMN_REAPER 

( COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  INTEGER; 

RETRIEVAL_LEN  :  in  RETRIEVA1_LENGTH ; 

RETRIEVALJBUF  :  in  RETRIEVAL_BUFFER)  is 


COLUMN_COUNTER  :  INTEGER; 

COLUMN_START  ;  INTEGER; 

COLUMN_END  :  INTEGER; 

begin 

COLUMN_COUNTER  0; 

COLUMN_START  1; 

COLUMN_END  COLUMN_ST ART ; 

loop 

if  COLUMN_END  >  RETRIEVAL_LEN  then 
raise  COLUMN_RANGE_ERROR ; 
end  if; 

if  RETRIEVAL_BUF  ( COLUMN_END )  -  ' | '  then 
COLUMN_COUNTER  COLUMN_COUNTER  +  1; 
end  if; 

if  COLUMN_COUNTER  -  COLUMN_NUMBER  then 
VAR  STRING_TO_INTEGER 

( RETRIEVAL_BUF  ( C0LUMN_ST ART  ..  COLUMN_END  -  1) ) ; 

exit; 

elsif  RETRIEVAL_r’JF  (COLUMN_END)  »  '  |  '  then 
COLUMN_START  COLUMN_END  +  1; 

COLUMN_END  COLUMN_START ; 

else 

COLUMN_END  COLUMN_END  +  1; 
end  if; 
end  loop; 

exception 

when  COLUMN_RANGE_ERROR  ->  raise  COLUMN_RANGE_ERROR; 
when  others  ->  raise  TYPE_CONVERSION_ERROR; 
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end  RDBMS_COLUMN_REAPER ; 


—  RDBMS_COLUMN_REAPER  -  extraction  of  a  float  column  from  the  retrieval 

—  buffer. 

procedure  RDBMS_COLUMN_REAPER 

(COLUMN_NUMBER  :  in  INTEGER; 

VAR  :  out  FLOAT; 

RETRI EV AL_LEN  :  in  RETRIEVAL_LENGTH ; 

RETRIEVAL_BUF  :  in  RETRIEVAL_BUFFER )  is 


COLUMN_COUNTER  :  INTEGER; 

COLUMN_START  :  INTEGER; 

COLUMN_END  :  INTEGER; 

begin 

COLUMN_COUNTER  0; 

COLUMN_START  1; 

COLUMN_END  COLUMN_ST ART ; 

loop 

if  COLUMN_END  >  RETRIEVAL_LEN  then 
raise  COLUMN_RANGE_ERROR; 
end  if; 

if  RETRIEVAL_BUF  (COLUMN_END)  -  ' | '  then 
C0LUMN_C0UNTER  COLUMN_COUNTER  +  1; 
end  if; 

if  COLUMN_COUNTER  -  COLUMN_NUMBER  then 
VAR  STRING_T0_FL0AT 

( RETRI EVAL_BUF  ( COLUMN_START  ..  COLUMN_END  -  1) ) ; 

exit; 

elsif  RETRIEVAL_BUF  ( COLUMN_END )  -  '  |  '  then 
COLUMN_START  COLUMN_END  +  1; 

COLUMN_END  C0LUMN_ START ; 

else 

COLUMN_END  COLUMN_END  +  1; 
end  if ; 
end  loop; 

— exception 

—  when  others  «>  raise  TYPE_CONVERSION_ERROR; 
end  RDBMS_COLUMN_REAPER; 


—  RDBMS_EXECUTE  -  execute  a  query  which  has  been  communicated  to  Oracle. 

procedure  RDBMS_EXECUTE 

(CURSOR  :  in  out  DAT A_AREA_TYPE )  is 

FILE  :  FILE_TYPE; 
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begin  # 

—  SQL  statement  associated  with  cursor  is  processed 

OEXEC  (CURSOR); 

RDBMS_ERROR_NUM  INTEGER  (CURSOR. RETURN_CODE) ; 
if  CURSOR . RETURN_CODE  /-  0  then 

if  CURSOR . RETURN_CODE  -  -1001  then 

raise  NO_DBOPEN_ERROR;  • 

elsif  CURSOR. V4_ERROR_CODE  -  1722  then 
raise  SYNTAX_ERROR; 
elsif  CURSOR. RETURN_CODE  -  -110  then 

—  commit  current  transaction  to  database 

OCOM  (LOGON_DATA_AREA); 

—  SQL  statement  associated  with  cursor  is  processed  # 

OEXEC  (CURSOR); 

RDBMS_ERROR_NUM  INTEGER  ( CURSOR . RETURN_CODE ) ; 
if  CURSOR. RETURN_CODE  /-  0  then 

if  CURSOR. RETURN_CODE  -  -1001  then 

raise  NO_DBOPENJERROR; 

elsif  CURSOR. V4_ERROR_CODE  -  1722  then  • 

raise  SYNTAX_ERROR ; 
else 

raise  UNHAND LED_RDBMS_ERROR ; 
end  if; 

elsif  CURSOR . FILLER_DATA_1  (2)  -  0  then 

if  CURSOR. FILLER_DATA_1  (1)  -  5  or  CURSOR .  ETLLER_DATA_1  (1)  =  9  then  • 

raise  NO_UPDATE_ERROR; 
end  if; 
end  if; 

elsif  CURSOR. RETURN_CODE  -  -9  then 
raise  DUPLICATE_REY_ERROR; 

else  ® 


raise  UNHANDLED_RDBMS_ERROR; 
end  if; 

elsif  CURSOR. FILLER_DATA_1  (2)  -  0  then 

if  CURSOR . FILLER_DATA_1  (1)  -  5  or  CURSOR . FILLER_DATA_1  (1)  -  9  then 
raise  NO_UPDATE_ERROR; 
end  if; 
end  if; 

end  RDBMS_EXECUTE; 


—  RDBMS_EXIT_D AT ABASE  -  log  the  user  off  a  database. 

procedure  RDBMS_EXIT_DATABASE  is 
begin 

if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR; 
else 

RDBMS_CLOSE_CURSOR  ( CURSOR_DATA_AREA . CURSOR_AREA ) ; 

—  disconnects  a  program  from  oracle 

OLOGOF  ( LOGON_DATA_AREA ) ; 
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RDBMS_ERROR_NUM  INTEGER  ( LOGON_DATA_AREA . RETURN_CODE ) ; 
if  LOGON_DATA_AREA.RETURN_CODE  /-  0  then 

if  LOGON_DATA_AREA.RETURN_CODE  -  -1012  then 

raise  NO_DBOPEN_ERROR ; 
else 

raise  UNHANDLED_RDBMS_ERROR ; 
end  if; 
end  if; 
end  if; 

DB_OPEN_FLAG  FALSE;  —  Set  flag  to  indicate  database  is  not  open 
end  RDBMS__EXIT_DATABASE; 


—  RDBMS_CLOSE_CURSOR  -  close  a  cursor 

procedure  RDBMS_CLOSE_CURSOR 

(CURSOR  :  in  out  DATA_AREA _TYPE )  is 

begin 

if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR; 
else 

—  disconnects  a  cursor  from  oracle 

OCLOSE  (CURSOR); 

RDBMS_ERROR_NUM  INTEGER  ( CURSOR . RETURN_CODE ) ; 
if  CURSOR. RETURN_CODE  /-  0  then 

if  CURSOR. RETURN_CODE  -  -1001  then 

raise  NO_DBOPEN_ERROR; 
else 

raise  UNHANDLED_RDBMS_ERROR; 
end  if; 
end  if; 
end  if; 

end  RDBMS_CLOSE_CURSOR; 


—  RDBMS_FETCH  -  fetch  data  into  the  user-program. 


procedure  RDBMS_FETCH 
(CURSOR 


in  out  CURS0R_0RACLE)  is 


COL_LENGTH 
COL_LENGTH_INT 
FTYPE 
FIELD_NUM 
FIELD  LENGTH 


array  (1 
array  (1 
INTEGER; 
INTEGER; 
INTEGER; 


127)  of  SHORT_INTEGER; 
127)  of  INTEGER; 


begin 

if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR ; 
else 

if  CURSOR. CURSOR  FIRST  FETCH  then 
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FIELD_NUM  1; 

while  FIELD_NUM  <-  127  loop 

—  return  type  &  size  of  field  of  SQL  query 

ODSC  ( CURSOR . CURSOR_DAT A . CURSOR_AREA ,  SHORT_INTEGER 
(FIELD_NUM) , 

DSIZE  ->  COL_LENGTH  (FIELD_NUM) ) ; 
exit  when  CURSOR . CURSOR_DATA . CURSOR_AREA . RETURN_CODE  /-  0; 
FIELD_NUM  FIELD_NUM  +  1; 
end  loop; 

FIELD_LENGTH  1; 

CURSOR . CURSOR_MAX_COLUMN  :  =  FIELD_NUM  -  1; 
for  COUNTER  in  1  . .  FIELD_NUM  -  1  loop 

—  define  output  buffer  for  one  field  of  SQL  query 

ODEFIN  ( CURSOR. CURSOR_DATA.CURSOR_AREA,  SHORT_INTEGER  (COUNTER), 
CURSOR . CURSO R_RET R I EV AL_B U F  ( FIELD_LENGTH ) ' ADDRESS , 
COL_LENGTH  (COUNTER),  1); 

FIELD_LENGTH  FIELD_LENGTH  +  INTEGER  (COL_LENGTH  (COUNTER)); 
CURSOR. CURSOR_RETRIEVAL_BUF  (FIELD_LENGTH)  :=  ' \'; 

FIELD_LENGTH  FIELD_LENGTH  +  1; 
end  loop; 

CURSOR. CURSOR_RETRXEVAL_LEN  FIELD_LENGTH ; 

CURSOR. CURSOR_FIRST_FETCH  FALSE; 

end  if; 

—  return  one  row  of  a  query  result 

OFETCH  ( CURSOR . CURSOR_DATA . CURSOR_AREA ) ; 

RDBMS_ERROR_NUM 

INTEGER  ( CURSOR . CURSOR_DATA . CURSOR_AREA . RETURN_CODE ) ; 
if  CURSOR. CURSOR_DATA.CURSOR_AREA.RETURN_CODE  /-  0  then 
if  CURSOR. CURSOR_DATA.CURSOR_AREA.V4_ERROR_CODE  -  1002  or 
CURSOR. CURSOR_DATA.CURSOR_AREA.V4_ERROR_CODE  -  1003  then 
raise  NO_RETRIEVE_ERROR; 

elsif  CURSOR. CURS0R_DATA.CURS0R_AREA.V4_ERR0R_C0DE  -  1403  then 
raise  NO_ROW_ERROR; 

elsif  CURSOR. CURSOR_DATA . CURSOR_AREA . V4_ERROR_CODE  -  1406  then 
RDBMS_ERROR_NUM  0; 
else 

raise  UNHANDLED_RDBMS_ERROR ; 
end  if; 
end  if; 
end  if; 

end  RDBMS  FETCH; 


—  RDBMS_OPEN_DATABASE  -  log  the  user  onto  a  database. 

procedure  RDBMS_OPEN_DATABASE 

(QUERY_BUFFER  :  in  BUFFER_ACCES  S_TYPE ; 
QUERY_LENGTH  :  in  INTEGER; 

QUERYX_BUFFER  :  in  BUFFER_ACCESS_TYPE; 
QUERYX_LENGTH  :  in  INTEGER)  is 

begin 
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if  DB_OPEN_FLAG  then 

raise  DB_ALREADY_OPEN_ERROR ; 
else 

—  establish  communication  between  oracle  and  the  user  program 

OLON  ( LOGON_DATA_AREA ,  QUERY_BUFFER . all ,  SHORT_INTEGER  ( QUERY_LENGTH ) , 
QUERYX_BUFFER.au,  SHORT_INTEGER  ( QUERYX_LENGTH ) )  ; 
RDBMS_ERROR_NUM  INTEGER  (LOGON_DATA_AREA. RETURN_CODE) ; 
if  LOGON_DATA_AREA.RETURN_CODE  /«  0  then 

if  LOGON_DATA_AREA.RETURN_CODE  =  -1017  then 

raise  DB0PEN_ERR0R / 
else 

raise  UNHANDLED_RDBMS_ERROR ; 
end  if; 
end  if; 

RDBMS_OPEN_CURSOR  { CURSOR_DATA_AREA . CURSOR_AREA ) ; 
end  if; 

DB_OPEN_FLAG  :«  TRUE; 
end  RDBMS_OPEN_DATABASE ; 


—  RDBMS_OPEN_CURSOR  -  open  a  cursor  under  a  particular  database. 

procedure  RDBMS_OPEN_CURSOR 

(CURSOR  s  in  out  DATA_AREA_TYPE)  is 

#  begin 

—  establishes  a  cursor  to  pass  a  SQL  statement  to  Oracle 
OOPEN  (CURSOR,  LOGON_DATA_AREA) ; 

RDBMS_ERROR_NUM  INTEGER  ( CURSOR . RETURN_CODE ) ; 
if  CURSOR_DATA_AREA.CURSOR_AREA.RETURN_CODE  /-  0  then 
raise  DBOPEN_ERROR; 

#  end  if; 

end  RDBMS_OPEN_CURSOR ; 


—  RDBMS_COMMIT_WORK  -  communicate  a  commit  work 

procedure  RDBMS_COMMIT_WORK  is 
begin 

if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR ; 
else 

—  commit  current  transaction  to  database 

OCOM  (LOGON_DATA_AREA); 
end  if; 

end  RDBMS _COMMIT_WORK ; 


—  RDBMS_ROLLBACK_WORK  -  communicate  a  rollback  transaction 

procedure  RDBMS_ROLLBACK_WORK  is 
begin 
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if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR; 
else 

—  roll  back  the  current  transaction 
OROL  (LOGON_DATA_AREA) ; 
end  if,* 

end  RDBMS_ROLLBACK_WORK; 


—  RDBMS_ONAME  -  retrieve  the  names  of  the  columns  used  in  a  SELECT  clause  of 

—  a  query. 

procedure  RDBMS_ONAME 

(CURSOR  :  in  out  DATA_AREA_TYPE ; 

NAMES  :  in  out  COLUMN_NAMES _TYPE ; 

NUMB ER_OF_NAME S  :  out  INTEGER)  is 

FIELD_NUM  :  INTEGER; 

begin 

if  not  DB_OPEN_FLAG  then 
raise  NO_DBOPEN_ERROR; 
else 

FIELD_NUM  1; 

while  FIELD_NUM  <-  127  loop 

NAMES  (FIELD_NUM) . COLUMN_NAME_LENGTH  18; 

—  get  names  of  columns  of  SQL  query 

ONAME  (CURSOR,  SHORT_INTEGER  (FIELD_NUM) ,  -1,  -1, 

NAMES  ( FIELD_NUM ) . COLUMN_NAME ' ADDRESS , 

NAMES  ( FIELD_NUM) . COLUMN_NAME_LENGTH ' ADDRESS ) ; 
exit  when  CURSOR . RETURN_CODE  /»  0; 

FIELD_NUM  FIELD_NUM  +  1; 
end  loop; 

NUMBER_OF_NAMES  FIELD_NUM  -  1; 
end  if; 

end  RDBMS_ONAME ; 


—  RDBMS_QUERY  -  communicate  a  query 

procedure  RDBMS_QUERY 
(QUERY_BUFFER 
QUERY_LENGTH 
CURSOR 

FILE  :  FILEJTYPE; 
begin 

if  not  DB_OPEN_FLAG  then 
raise  N0_DB0PEN_ERR0R ; 
else 


in  out  BUFFER_ACCESS_TYPE; 
in  INTEGER; 

in  out  DATA_AREA_TYPE)  is 
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—  associated  SQL  statement  with  cursor  &  pass  it  to  oracle 

0SQL3  (CURSOR,  QUERY_BUFFER . all ,  SHORT_INTEGER  ( QUERY_LENGTH ) ) 
RDBMS_ERROR_NUM  INTEGER  (CURSOR. RETURN_CODE) ; 
if  CURSOR . RETURN_CODE  /-  0  then 

if  CURSOR . RETURN_CODE  -  -1001  then 

raise  NO_DBOPEN_ERROR; 
elsif  CURSOR. V4_ERROR_CODE  -  704  then 
raise  COLUMN_ERROR; 
elsif  CURSOR. V4_ERROR_CODE  -  901  or 

CURSOR. V4_ERROR_CODE  -  955  then 
raise  CREATE_ERROR ; 
elsif  CURSOR. V4_ERROR_CODE  =942  then 
raise  NO_TABLE_ERROR; 
elsif  CURSOR. V4_ERROR_CODE  =  902  or 
CURSOR . V4_ERROR_CODE  =  984  or 
CURSOR. V4_ERROR_CODE  =  1722  then 
raise  SYNTAXJERROR; 
elsif  CURSOR. RETURN_CODE  -  -1747  then 
raise  ACCESS_ERROR; 
else 

raise  UNHANDLED_RDBMS_ERROR; 
end  if; 
end  if; 

RDBMS_EXECUTE  (CURSOR); 
end  if; 

—  FREE  (QUERY_BUFFER) ; 
end  RDBMS_QUERY; 


—  STRING_TO_INTEGER  -  convert  a  string  to  an  integer 

function  STRING_TO_INTEGER 
(STR  :  in  STRING) 

return  INTEGER  is 

VAL_INT  :  INTEGER; 

I  :  INTEGER; 

EXP  :  INTEGER; 

NEG AT I VE_FLAG  :  BOOLEAN; 

begin 

NEG AT I VE_F LAG  :»  FALSE; 

EXP  10; 

I  :=  0; 

VAL_INT  : =  0; 

for  J  in  reverse  STR 'range  loop 
if  STR  (J)  =  '0'  then 
I  :=  0; 

elsif  STR  (J)  =  then 
I  :=  1; 

elsif  STR  (J)  =  '2'  then 
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I  : 

2; 

elsif 

STR 

(J) 

m 

I  : 

3; 

elsif 

STR 

(J) 

m 

I  : 

4; 

elsif 

STR 

(J) 

m 

I  : 

5; 

elsif 

STR 

(J) 

- 

I  : 

6  s 

elsif 

STR 

(J) 

m 

I  : 

7; 

elsif 

STR 

(J) 

- 

I  : 

8; 

elsif 

STR 

(J) 

*s 

I  : 

9; 

elsif 

STR 

(J) 

m 

NEGATIVE_FLAG 

exit; 

elsif  STR  (J)  - 
exit; 
else 


'3'  then 

'  4 '  then 

'5'  then 

'  6 '  then 

'7'  then 

' 8 '  then 

'  9 '  then 

' - '  then 
TRUE; 

'  '  or  STR  (J) 


'+'  then 


raise  TYPE_CONVERSION_ERROR; 
end  if; 

VAL_INT  :«■  VAL_INT  +  (I  *  (EXP  **  (STR' LAST  -  J)  )  ) 
end  loop; 

if  NEGATIVE_FLAG  then 

VAL_INT  s-  VAL_INT  *  (-1) ; 
end  if; 

return  VAL_INT ; 
end  STRING_TO_INTEGER; 


—  STRING_TO_FLOAT  -  convert  a  string  to  a  float 

function  STRING_TO_FLOAT 
(STR  :  in  STRING) 
return  FLOAT  is 

package  FLT_IO  is  new  FLOAT_IO  ( LONG_LONG_FLOAT ) ; 
use  FLT_IO; 

VAL_FLT  i  LONG_LONG_FLOAT; 

LAST  :  INTEGER; 

DOT  :  BOOLEAN; 

begin 

for  I  in  STR' FIRST  ..  STR ' LAST  loop 
if  STR  (I)  /-  '  '  then 
if  STR  (I)  -  then 

GET  ("0"  &  STR  (I  ..  STR' LAST) ,  VAL_FLT,  LAST) 
else 

DOT  FALSE; 
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for  J  in  I  . .  STR'LAST  loop 
if  STR  (J)  -  '  . '  then 


TRUE; 


DOT 
exit 
end  if 
end  loop 
if  DOT  then 
GET  ( STR  (I 
else 

GET  ( STR  (I 
end  if; 
end  if; 
exit ; 
end  if; 
end  loop; 

return  FLOAT  (VAL_FLT) ; 
end  STRING_TO_FLOAT; 


STR'LAST),  VAL_FLT ,  LAST); 
STR'LAST)  £  ".0",  VAL_FLT ,  LAST) 


—  RANGE_COUNT 

function  RANGE_COUNT 

(STR  i  in  STRING) 
return  INTEGER  is 

RANGE_OF  i  constant  STRING  (1  ..  8)  :•  "range  of"; 
COUNT  :  INTEGER  1/ 

begin 

for  I  in  STR 'FIRST  ..  STR'LAST  -  8  loop 
if  STR  (I  . .  I  +  7 )  -  RANGE_0F  then 
COUNT  COUNT  +  1; 
end  if; 
end  loop; 
return  COUNT; 
end  RANGE_COUNT ; 

end  RDBMS_INTERFACE; 

3.10.10  package  FUNCTIONB.ADA 

with  TEXT_PRINT,  TEXT_IO,  RDBMS_INTERFACE ; 
use  TEXT_PRINT,  TEXT_IO,  RDBMS_INTERFACE ; 

package  body  ADA_SQL_FUNCT ION S  is 

INDENT  :  STANDARD . INTEGER; 

FETCH_CURSOR  :  CURSOR_NAME; 

OPERAT ION_CURSOR  :  CURSOR_NAME  new  CURSOR_NAME_RECORD 
DOING  A  SELECT  :  BOOLEAN  :»  FALSE; 
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package  DOUBLE_PREC I S I ON_PRINT  is  new 
FLOAT_PRINT  (  DATABASE. DOUBLE_PRECISION  ); 

package  INT_PRINT  is  new  INTEGER_PR7.NT  (  DATABASE.  INT  ); 

use  DOUB  LE_P REC I S I ON_P R I NT  ,  INT_PRINT ; 

LINE  :  LINE_TYPE; 


-  declarations  for  print  routines  (since  some  are  recursive  and  mutually 
recursive) 


procedure 

SHOW. 

_VALUE_SPEC I F ICAT ION 

(  s 

:  in 

SQL_OBJECT 

)  ; 

procedure 

SHOW. 

_ALL_SET_F  UNCT I ON 

(  s 

:  in 

SQL_OBJECT 

)  /• 

procedure 

SHOW. 

_VALUE_EXPRESSION 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

_BETWEEN_PREDICATE 

(  s 

:  in 

SQL_OBJECT 

)  ; 

procedure 

SHOW. 

_IN_VALUE_LI ST 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

_LIKE_PREDICATE 

(  s 

:  in 

SQL_OBJECT 

) 

procedure 

SHOW. 

_SEARCH_CONDITION 

(  s 

:  in 

SQL_OBJECT 

) 

procedure 

SHOW. 

_TABLE_EXPRESSION 

(  s 

:  in 

SQL_OBJECT 

) ; 

procedure 

SHOW. 

_QUERY_SPECIFICATION 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

_SELECT_LI ST 

(  s 

:  in 

SQL_OBJECT 

) ; 

procedure 

SHOW. 

.ORDER_BY_CLAUSE 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

_INSERT_VALUE_LIST 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

_SET_CLAU  SES 

(  s 

:  in 

SQL_OBJECT 

); 

procedure 

SHOW. 

.COMPARI SON_PRED ICATE 

(  s 

in  SQL_OBJECT  ;  P  : 

in 

STANDARD. STRING 

) ; 

procedure 

SHOW. 

_IN_PREDICATE 

(  s 

in  SQL_OBJECT  ;  P  : 

in 

STANDARD . STRING 

); 

procedure  INITIATE_TEST  is  —  *****  FOR  TESTING  ONLY 
begin 

CREATE_LINE  (  LINE  ,  79  ); 

SET_LINE  (  LINE  ) ; 

SET_CONTINUATION_INDENT  (  7  ) ; 
end  INITIATEJTEST; 


—  constant  literal  value  generator 


function  CONST ANT_LITERAL  return  RESULT_TYPE  is 
begin 

return  VALUE; 
end  CONST ANT_LITERAL; 


—  conversion  routines  for  SQL  objects 


function  L_CONVERT  (  L  :  TYPED_SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 
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function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPED_SQL_OBJECT  is 
begin 

return  TYPED_SQL_OBJECT  (  R  ) ; 
end  CONVERT_R; 

package  body  CONVERT  is 

function  L_CONVERT  {  L  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

return  L; 
end  L_CONVERT; 

function  L_CONVERT  (  L  :  TABLE_NAME  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERTER  (  R  :  SQL_OBJECT  )  return  TABLE_NAME  is 
begin 

return  TABLE_NAME  (  R  ); 
end  CONVERT_R; 

function  L_CONVERT  (  L  :  TABLE_LIST  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TABLE_LIST  is 
begin 

return  TABLE_LIST  (  R  ) ; 
end  CONVERT_R; 

function  li_CONVERT  (  L  :  INSERT_ITEM  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  {  L  ); 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  INSERT_ITEM  is 
begin 

return  INSERT_ITEM  (  R  )/ 
end  CONVERT_R; 

end  CONVERT; 

-  conversion  routines  for  user  types 

function  INTEG ER_AND_ENUMERAT I ON_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT  is 
begin 
return 

new  SQL  OB JECT_RECORD ' 
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(  VALUE  ,  null  ,  (  INTEGER  ,  USER_TYPE' POS  (  VAR  )  )  ); 
end  INTEGER_AND_ENUMERATION_CONVERT ; 

function  FLOAT_CONVERT  (  VAR  :  USER_TYPE  )  return  SQL_OBJECT  is 
begin 
return 

new  SQL_OB JECT_RECORD ' 

(  VALUE  ,  null  ,  (  FLOAT  ,  DATABASE . DOUBLE_PRECI SION  (  VAR  )  )  ) 
end  FLOAT_CONVERT; 

function  NUMBER_OF_QUOTES_IN  (  S  :  STANDARD . STRING  ) 
return  STANDARD . INTEGER  is 
C  :  STANDARD . INTEGER  :=  0; 
begin 

for  I  in  S' RANGE  loop 
if  S(I)  -  then 
C  C  +  1; 
end  if; 
end  loop; 
return  C; 

end  NUMBER_OF_QUOTES_IN; 

function  SQL_OBJECT_FOR_STRING  (  S  :  in  STANDARD . STRING  ) 
return  SQL_0BJECT  is 

L  :  STANDARD.  INTEGER  NUMBER_OF_QUOTES_IN  (  S  ); 

J  :  POSITIVE  1; 

R  s  ACCESS_STRING  s-  new  STANDARD . STRING  (  1  ..  S' LENGTH  +  L  ) ; 
begin 

if  L  ■  0  then 
R. all  S; 

else 

for  I  in  S' RANGE  loop 
if  S(I)  -  ' "  then 

R  (  J  .  .  J+l  )  : -  * " " ; 

J  J  +  2; 

else 

R(J)  S ( I ) ; 

J  J  +  1; 
end  if; 
end  loop; 
end  if; 

return  new  SQL_0B JECT_RECORD '  (  VALUE  ,  null  ,  (  STRING  ,  R  )  ); 
end  SQL_0B JECT_FOR_STRING ; 

function  UNCONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT_FOR_STRING  (  STANDARD . STRING  (  VAR  )  ); 
end  UNCONSTRAINED_CHARACTER_STRING_ CONVERT ; 

function  CONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USERJIYPE  ) 
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return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT_FOR_STRING  (  STANDARD . STRING  (  VAR  )  ); 
end  CONSTRAINED_CHARACTER_STRING_CONVERT ; 

function  UNCONSTRAINED_STRING_CONVERT  {  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT  is 

S  :  STANDARD. STRING  (  1  ..  VAR' LENGTH  ); 

I  :  POSITIVE  1/ 
begin 

for  J  in  VAR' RANGE  loop 

S(I)  CONVERT j:OMPONENT_TO_CHARACTER  (  VAR(J)  )/ 

I  :»  I  +  1; 
end  loop; 

return  SQL_OBJECT  JPOR_STRING  (  S  ) ; 
end  UNCONSTRAINED_STRING_CONVERT; 

function  CONSTRAINED_STRING_CONVERT  {  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT  is 

S  :  STANDARD. STRING  (  1  ..  VAR' LENGTH  ); 

I  :  POSITIVE  1; 
begin 

for  J  in  VAR' RANGE  loop 

S(I)  CONVERT_COMPONENT_TO_CHARACTER  (  VAR(J)  ); 

I  I  +  1; 
end  loop; 

return  SQL_OBJECT_FOR_STRING  (  S  ); 
end  CONSTRAINED_STRING_CONVERT; 


—  column  and  table  name  routines 
package  body  NAME_PACKAGE  is 

NAME_P  :  constant  DATABASE_NAME  :=  new  STANDARD . STRING '  (  GIVEN_NAME  ); 

NAME_0  :  constant  SQL_OBJECT 
new  SQL_OB JECT_RECORD '  (  NAME  ,  null  ,  NAME_P  ); 

function  COLUMN_OR_TABLE_NAME  return  SQL_OBJECT_TYPE  is 
begin 

return  CONVERT_R  (  NAME_0  ); 
end  COLUMN_OR_T AB  LE_NAME ; 

function  TABLE_NAME_WITH_COLUMN_LIST  (  COLUMNS  :  SQL_OBJECT  ) 
return  TABLE_NAME  is 

N  •.  SQL_OBJECT  new  SQL_OB JECT_RECORD '  (  NAME  ,  COLUMNS  ,  NAME_P  ); 
begin 
return 

new  SQL_OB JECT_RECORD '  {  OPERATION  ,  null  ,  0_TABLE_C0LUMN_LI ST  ,  N  ) 
end  TAB LE_NAME_WI TH_COLUMN_L I ST ; 
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end  NAME_PACKAGE; 

—  value  specification  routines 

function  INDICATOR_FUNCTION  (  VAL  :  USER__TYPE  )  return  RESULT_TYPE  is 
begin 

return  CONVERT_R  (  L_CONVERT  {  VAL  )  ); 
end  INDICATOR_FUNCTION ; 

—  generic  operation  routines 

function  COPY_NAME  (  OBJECT  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

if  OBJECT  /-  null  and  then  OBJECT. KIND  =  NAME  then 
return  new  SQL_OB JECT_RECORD '  (  OBJECT. all  ); 
else 

return  OBJECT; 
end  if; 

end  COPY_NAME; 

function  UNARY_OPERATION  (  L  :  LJEYPE  )  return  TYPE_R  is 
begin 
return 
CONVERT_R 

(  new  SQLOB JECTRECORD ' 

(  OPERATION  ,  null  ,  GI VEN_OPERAT ION  ,  L_CONVERT  (  L  )  )  ); 
end  UNARY_OPERATION; 

function  BINARY_OPERATION  (  L  :  L_TYPE  ;  R  :  R_TYPE  )  return  TYPE_R  is 
LEFT  :  SQL_OBJECT  COPY_NAME  {  L_CONVERT  (  L  )  ); 
begin 

LEFT. ACROSS  R_CONVERT  (  R  ) ; 
return 
CONVERT_R 

(  new  SQL_OB JECT_RECORD '  <  OPERATION  ,  null  ,  GIVEN_OPERATION  ,  LEFT  )  ) 
end  BINARY  OPERATION; 


—  set  function  routines 

function  COUNT_STAR  return  TYPE_R  is 
begin 
return 
CONVERT_R 

(  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_C0UNT_STAR  ,  null  )  ); 
end  COUNT_STAR; 

—  subquery  routines 

function  NEW_TAIL  (  L  ,  R  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

if  R  -  null  then 
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L. ACROSS 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_NULL_0P  ,  null  ); 
else 

L. ACROSS  R; 
end  if; 

return  L. ACROSS; 
end  NEWJEAIL; 

function  BUILD_SELECT 

(  SELECTJTYPE  :  SQL_0PERATI0N; 

WHAT  :  SQL_0B JECT ; 

FROM  :  TABLEJLIST; 

WHERE  ,  GROUP_BY  ,  HAVING  :  SQL_OBJECT  ) 

return  SQL_OBJECT  is 

F  :  SQL_OBJECT  : -  C0PY_NAME  (  SQL_OBJECT  (  FROM  )  ); 

W  :  SQL_OBJECT  COPY_NAME  (  WHAT  ); 

TAIL  :  SQL_OBJECT 
NEW_TAIL 
(  NEWJTAIL 

{  NEW_TAIL  (  F  ,  WHERE  )  ,  COPY_NAME  (  GROUP_BY  )  )  ,  HAVING  ); 

begin 

W. ACROSS  F; 

return  new  SQL__OB JECT_RECORD '  (  OPERATION  ,  null  ,  SELECTJTYPE  ,  W  ) 
end  BUILD_SELECT; 


function  SELECT  LIST 


( 


WHAT 

FROM 

WHERE 

GROUP_BY 

HAVING 


SUBQUERY 
WHAT_TYPE ; 
TABLE_LIST ; 
SQL_OBJECT 
SQL_OBJECT 
SQL_OBJECT 


NULL_SQL_OB JECT ; 

NULL_SQL_OB JECT ; 

NULL_SQL_OBJECT  )  return  TYPE_R  is 


begin 


return 


CONVERT_R 
(  BUILD__SELECT 
(  SELECT  JEYPE, 

L_CONVERT  (  WHAT  )  ,  FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ); 
end  SELECT_LIST_SUBQUERY; 


function  STAR  SUBQUERY 


(  FROM 

TABLE_LIST 

/ 

WHERE 

SQL_OBJECT 

NULL_SQL_OB JECT ; 

GROUP_BY  : 

SQL_OBJECT 

NULL_SQL_OB JECT ; 

HAVING 

SQL_OBJECT 

NXJLL_SQL_OBJECT  ) 

return  TYPE_R  is 

begin 

return 

CONVERT_R 
(  BUILD_SELECT 
{  SELECT_TYPE , 
new  SQL_OBJECT 

_RECORD '  ( 

OPERATION  ,  null  ,  0_ 

STAR  ,  null  ) , 

FROM  ,  WHERE  , 

GROUP_BY  , 

HAVING  )  ); 
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end  STAR_SUBQUERY; 

—  print  routines 

—  5.6.1  <value  specification > 

procedure  SHOW_VALUE_SPECI F I CAT X ON  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S. VALUE. KIND  is 

when  INTEGER  ->  PRINT  (  S . VALUE . INTEGER  ); 
when  FLOAT  ->  PRINT  (  S . VALUE . FLOAT  ); 
when  STRING  =>  PRINT  (  &  S . VALUE . STRING . all  & 

end  case; 

end  SHOW_VALUE_SPECIFICATION; 

—  5.8.3  <all  set  function) 

procedure  SHOW_ALL_SET_FUNCTION  (  S  :  in  SQL_OBJECT  )  is 
begin 


ease  S. OPERATION 

is 

when  0_AVG 

=■*> 

PRINT 

( 

"AVG< 

"  ): 

when  0_MAX 

=  > 

PRINT 

( 

*MAX( 

"  )/ 

when  0_MIN 

-> 

PRINT 

( 

"MIN( 

"  )/ 

when  0_SUM 

=  > 

PRINT 

( 

"SUM( 

"  ); 

when  others 

-> 

raise 

INTERNAL 

ERROR; 

end  case; 

SHOW_V ALUE_EXP RE S S I ON  (  S. OPERANDS  ); 

PRINT  (  "  )"  ) ; 
end  SHOW_ALL_SET_FUNCTION; 

—  5.9.1  <value  expression) 

procedure  PARENTHESIZE_ADDING_OPERANDS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXPRES SION  (  S  ); 

PRINT  (  P  ); 

if  S . ACROSS . KIND  -  OPERATION  then 
case  S . ACROSS . OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  -> 

PRINT  (  ■(  "  ) ; 

SHOW_VALUE_EXP RE S S I ON  (  S. ACROSS  ); 

PRINT  (  "  ) "  ) ; 
when  others  *■> 

SHOW_VALUE_EXP  RE  SSI ON  (  S. ACROSS  ); 
end  case ; 
else 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ); 
end  if; 

end  PARENTHESIZE_ADDING_OPERANDS ; 
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procedure  PARENTHESIZE_MULTIPLYING_OPERANDS 

{  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

if  S.KIND  -  OPERATION  then 
case  S. OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  j  0_MINUS  -> 

PRINT  {  "(  *  ) ; 

SHOW_VALUE_EXPRE S SION  (  S  ); 

PRINT  {  "  )"  ); 
when  others  ■> 

SHOW_VALUE_EXPRE S S I ON  (  S  ); 
end  case; 
else 

SHOW_VALUE_EXPRES SI ON  (  S  ); 
end  if; 

PRINT  (  P  ); 

if  S. ACROSS. KIND  =  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_UNARY_MINUS  |  OJPLUS  |  0_MINUS  |  0_TIMES  |  0_DIVIDE  -> 

PRINT  {  "(  "  ) ; 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 

PRINT  (")*); 
when  others  •»> 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRES S ION  {  S. ACROSS  ); 
end  if; 

end  PARENTHESIZE_MULTIPLYING_OPERANDS; 

procedure  SHOW_VALUE__EXPRESSION  (  S  :  in  SQL_OBJECT  >  is 
begin 

case  S.KIND  is 
when  VALUE  -> 

SHOW_VALUE_SPECIFICATION  (  S  ); 
when  NAME  -> 

PRINT  (  S. NAME. all  ); 
when  OPERATION  -> 
case  S. OPERATION  is 

when  0_AVG  |  0_MAX  |  0_MIN  |  0_SUM  -> 

SHOW_ALL_SET_i!  UNCTION  (  S  ); 
when  0_C0UNT_STAR  »> 

PRINT  (  " COUNT ( * ) "  ) ; 
when  0_UNARY_PLUS  -> 

SHOW_VALUE_EXPRESS ION  {  S. OPERANDS  ); 
when  0_UNARY_MINUS  -> 

PRINT  (  "  -  "  ); 

if  S . OPERANDS . KIND  -  OPERATION  then 
case  S. OPERANDS. OPERATION  is 

when  0_UNARY_MI NU S  |  0_PLUS  |  0_MINUS  |  0_TIMES  |  0_DIVIDE  »> 
PRINT  (  "(  "  ) ; 
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SHOW_VALUE_EXPRESSION  (  S . OPERANDS  ); 

PRINT  (  "  )"  ) ; 

when  others  ->  SHOW_VALUE_EXP RE S S ION  (  S. OPERANDS  ); 

end  case; 
else 

SHOW_VALUE_EXP RES SION  (  S. OPERANDS  ); 
end  if; 

when  0_PLUS  -> 

P ARENTHESI ZE_ADD ING_OP BRAND S  (  S. OPERANDS  ,  "  +  "  ); 
when  0_MINUS  -> 

P ARENTHESI ZE_ADDING_OPERANDS  (  S. OPERANDS  ,  "  -  "  ); 
when  0_TIMES  ■> 

P ARENTHESI ZE_MULT IP LY ING_OPERAND S  (  S  .  OPERANDS  ,  "  *  *  ); 
when  0_DIVIDE  -> 

PARENTHESIZE_MULTIPLYING_OPERANDS  (  S . OPERANDS  ,  *  /  *  ); 
when  others  ->  raise  INTERN AL_ERROR ; 
end  case; 
end  case; 

end  SHOW  VAL UE_EXP RES S ION / 

—  5.11.1  < comparison  predicate) 

procedure  SHOW_COMPARISON_PREDICATE 

(  S  7  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXPRESSION  <  S  ); 

PRINT  (  P  ); 

if  S. ACROSS. KIND  -  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  -> 

SHOW_QUERY_SPECI F I CAT ION  (  S. ACROSS  ); 
when  others  -> 

SHOW_VALUE_EXPRES SION  (  S. ACROSS  >; 
end  case; 
else 

SHOW_VALUE_EXPRESS ION  (  S. ACROSS  ); 
end  if; 

end  SHOW_COMPARISON_PREDICATE; 

—  5.12.1  <between  predicate) 

procedure  SHOW_BETWEEN_PREDICATE  (  S  :  in  SQL_OBJECT  )  is 

OPERAND  :  SQL_OBJECT  S  .ACROSS .  OPERANDS;  —  first  operand  of  AND 
begin 

SHOW_V ALUE_EXP  RES  S ION  (  S  ) ; 

PRINT  (  *  BETWEEN  "  ); 

SHOW_V ALUE_EXP RE S S I ON  (  OPERAND  ) ; 

PRINT  (  "  AND  *  ) ; 

SHOW_VAIiUE_EXPRESSION  (  OPERAND .  ACROSS  ); 
end  SHOW_BETWEEN_PREDICATE ; 


I 
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—  5.13.1  <in  predicate) 

procedure  SHOW_IN_PREDICATE 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

PRINT  (  P  ); 

SHOW_VALUE_EXPRES S ION  (  S  )/ 

PRINT  (  "IN  *  ) ; 
if  S. ACROSS. KIND  -  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  => 

SHOW_QUERY_S P EC I F I CATION  (  S. ACROSS  ); 
return; 

when  others  =*> 
null ; 
end  case; 
end  if; 

PRINT  (  "(  "  );  — (  "<  "  ) ; 

SHOW_IN_VALUE_L I ST  (  S. ACROSS  );  PRINT  (  "  )"  );  — (  "  >"  ); 
end  SHOW_IN_PREDICATE; 

—  5.13.2  <in  value  list) 

procedure  SHOW_IN_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  -> 

SHOW_VALUE_SPECIFICATION  (  S  ); 
when  OPERATION  -> 

if  S. OPERATION  /-  0_0R  then 
raise  INTERN AL_ERROR ; 
end  if; 

SHOW_IN_VALUE_L 1ST  (  S. OPERANDS  ); 

PRINT  (  ",  "  ) ; 

SHOW_IN_VALUE_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  ■> 

raise  INTERNAL_ERROR ; 
end  case; 

end  SHOW_IN_VALUE_LIST; 

—  5.14.1  <like  predicate) 

procedure  SHOW_LIKE_PREDICATE  (  S  :  in  SQL_OBJECT  )  is 

P  :  ACCESS_STRING  S .ACROSS. VALUE. STRING;  —  must  be  of  right  type 
begin 

PRINT  (  S. NAME. all  );  PRINT  (  "  LIKE  "  );  — (  "  -  "  ); 

— for  I  in  P' RANGE  loop 
— case  P(I)  is 

— when  ->  P(I)  '?'; 

— when  '%'  ->  P(I)  := 

— when  others  =*>  null; 
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— end  case; 

— end  loop; 

SHOW_VALUE_SPECIFICATION  (  S. ACROSS  ); 
end  SHOW_LIXE_PREDICATE; 

—  5.18.1  < search  condition > 

procedure  PARENTHESIZE_RELATIONAL_OPERATORS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 
OPERAND  :  SQL_OBJECT  S. OPERANDS; 
begin 

case  OPERAND . OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  -> 

if  OPERAND . OPERATION  /-  S. OPERATION  then 
PRINT  ("(");  — ("["); 

SHOW_SEARCH_CONDITION  (  OPERAND  ) ;  PRINT  (")");  — (  "  ] "  ) 

else 

SHOW_SEARCH_CONDITION  (  OPERAND  ); 
end  if; 

when  others  »>  SHOW_SEARCH_CONDITION  (  OPERAND  ); 
end  case; 

PRINTLINE;  PRINT  (  P  ); 

OPERAND  :»  OPERAND . ACROSS ; 

case  OPERAND . OPERATION  is  —  again,  must  be  operation 
when  0_AND  |  0_OR  **> 

PRINT  ("(");  —("[•); 

SHOW_SEARCH_CONDITION  (  OPERAND  );  PRINT  (")"); 
when  others  -> 

SHOW_SEARCH_CONDITI ON  (  OPERAND  ); 
end  case; 

end  PARENTHESI ZE_RELATIONAL_OPERATORS ; 


procedure  SHOW_SEARCH_CONDITION  (  S  :  in  SQL_OBJECT  )  is 
begin 


case  S. 

OPERATION 

is 

when 

0_EQ 

-> 

SHOW_COMPARI SON_PREDI CATE 

( 

S . OPERANDS 

It  _  It 

r 

)/ 

when 

0_NE 

«> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

tt  tt 

r 

); 

when 

0_LT 

-> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

,  "  <  " 

); 

when 

0_GT 

-> 

SHOW_COMPARI SON_PREDICATE 

( 

S . OPERANDS 

,  "  >  " 

); 

when 

0_LE 

-> 

SHOW_COMPARI S ON_P RED I C AT E 

( 

S . OPERANDS 

); 

when 

0_GE 

-> 

SHOW_COMPARISON_PREDICATE 

( 

S . OPERANDS 

); 

when 

0_BETWEEN 

-> 

SHOW_BETWEEN_PREDICATE 

( 

S. OPERANDS 

); 

when 

0~IS_IN 

-> 

SHOW_IN_PREDICATE 

( 

S . OPERANDS 

,  ""  ) ; 

when 

0_N0T_IN 

-> 

SHOW_IN_PREDICATE 

< 

S . OPERANDS 

,  "NOT" 

)/ 

when 

0_LIKE 

-> 

SHOW_LIKE_PREDICATE 

< 

S . OPERANDS 

); 

when 

0_AND 

-> 

PARENTHES I ZE_RELAT IONAL_OPERATORS  (  S  , 

"AND 

"  ) ; 

when 

when 

0_0R 

0  NOT  -> 

-> 

PARENTHESI ZE_RELATIONAL_OPERATORS  (  S  , 

"OR 

"  ); 

PRINT  (  "NOT  "  ) ; 

case  S . OPERANDS . OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  *»> 


» 
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PRINT  ("<”);  — ("["); 

SHOW_SEARCH_COND ITION  (  S . OPERANDS  ); 

PRINT  (")"); 
when  others  »»> 

SHOW_SEARCH_CONDITION  (  S. OPERANDS  ); 
end  case; 

when  others  »>  raise  INTERNAL_ERROR; 
end  case; 

end  SHOW_SEARCH_CONDITION; 

—  5.19.1  <table  expression> 

procedure  SHOW_TABLE_EXPRESSION  (  S  :  in  SQL_OBJECT  )  is 
CLAUSE  :  SQL_OBJECT  S. ACROSS; 
begin 

PRINT  (  "FROM  "  );  SHOW_SELECT_LIST  (  S  ); 

if  CLAUSE. OPERATION  /*  0_NULL_0P  then  —  WHERE  must  have  operation  on  top 
PRINT_LINE;  PRINT  (  "WHERE  "  ) ;  SHOW_SEARCH_CONDITION  (  CLAUSE  ) ; 
end  if; 

CLAUSE  CLAUSE. ACROSS; 

if  CLAUSE. KIND  /-  OPERATION  or  else  CLAUSE . OPERATION  /-  0_NULL_0P  then 
PRINT_LINE;  PRINT  (  "GROUP  BY  "  );  SHOW_SELECT_LIST  (  CLAUSE  ); 
end  if; 

CLAUSE  CLAUSE. ACROSS; 

if  CLAUSE. OPERATION  /-  0_NULL_0P  then  —  same  as  WHERE 

PRINTLINE;  PRINT  (  "HAVING*""  );  SHOW_SEARCH_CONDITION  (  CLAUSE  ); 
end  if; 

end  SHOW_TABLE_EXPRES  S ION ; 

—  5.25.1  <query  specif ication> 

procedure  SHOW_QUERY_SPECIFICATION  (  S  :  in  SQL_OBJECT)  is 
CLAUSE  :  SQL_OBJECT  : -  S. OPERANDS; 
begin 

INDENT  INDENT  +  7;  PRINT_LINE; 
if  INDENT  >  0  then 

SET_INDENT  (  INDENT  -  2  ) ; 

PRINT  (  "(  "  ) ; 
end  if; 

SET_INDENT  (  INDENT  ); 

PRINT  (  "SELECT  "  ); 
case  S. OPERATION  is 

when  0_SELEC  ->  null; 

when  0_SELECT_DI ST INCT  ->  PRINT  (  "UNIQUE  "); 
when  others  ->  raise  INTERNAL_ERROR ; 

end  case; 

SHOW_SELECT_LI ST  (  CLAUSE  ); 

PRINTLINE; 

SHOW_TABLE_EXPRESS ION  (  CLAUSE . ACROSS  ); 

INDENT  INDENT  -  7; 
if  INDENT  >-  0  then 
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PRINT  (  *  )"  ) ; 

SET_INDENT  (  INDENT  ) ; 
end  if; 

end  SHOW_QUERY_SP EC I F I CATION ; 

—  5.25.2  <select  list> 

procedure  SHOW_SELECT_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 

when  NAME  |  VALUE  -> 

SHOW_VALUE_EXPRES S ION  (  S  ); 
when  OPERATION  -> 
case  S. OPERATION  is 
when  0_STAR  »> 

PRINT  (  "*"  ) ; 
when  0_AMPERSAND  -> 

SHOW_SELECT_LIST  {  S. OPERANDS  ); 

PRINT  {  ",  "  ) ; 

SHOW_SELECT_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  «■> 

SHOW_V ALUE_EXP RE S S I ON  (  S  ); 
end  case; 
end  case; 

end  SHOW_SELECT_LIST; 

—  8.3.5  <order  by  clause> 

procedure  SHOW_ORDER_BY_CLAUSE  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 

when  NAME  |  VALUE  -> 

SHOW_VALUE_EXP RES S ION  (  S  ); 
when  OPERATION  »> 
case  S. OPERATION  is 
when  0_AMPERSAND  -> 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS  ); 

PRINT  (  ",  "  ) ; 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS . ACROSS  ); 
when  0_ASC  *> 

SHOW_V ALUE_EXP RES S ION  (  S . OPERANDS  ) ; 
when  0_DESC  -> 

SHO W_V AL UE_EXP RE S S I ON  {  S . OPERANDS  )/ 

PRINT  (  "  DESC"  ) ; 
when  others  -> 

raise  INTERN AL_ERROR ; 
end  case; 
end  case; 

end  SHOW_ORDER_BY_CLAUSE; 

—  8.7.3  <insert  value  list> 
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procedure  SHOW_INSERT_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  -> 

SHOW_VALUE_SPECIFICATION  {  S  ); 
when  OPERATION  -> 
case  S. OPERATION  is 
when  0_AND  -> 

SHOW_IN SERT_VALUE_L 1ST  (  S . OPERANDS  ) ; 

PRINT  (  ",  "  ) ; 
when  0_LE  »> 
null ; 

when  others  -> 

raise  INTERNAL_ERROR ; 
end  case; 

SHOW_INSERT_VALUE_LI ST  (  S . OPERANDS . ACROSS  ); 
when  others  *■> 

raise  INTERN AL_ERROR ; 
end  case; 

end  SHOW_INSERT_VALUE_LIST; 

—  8.11.2  <set  clause> 

procedure  SHOW_SET_CLAUSES  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S.  OPERATION  is  —  must  be  operation 
when  0_AND  -> 

SHOW_SET_CLAUSES  (  S.  OPERANDS  );  PRINT  (  );  PRINTLINE; 

SHOW_SET_CLAUSES  {  S. OPERANDS. ACROSS  ); 
when  0_LE  -> 

PRINT  (  S. OPERANDS. NAME. all  &  "  -  "  ); 

SHOW_VALUE_EXPRESSION  {  S . OPERANDS . ACROSS  ); 
when  others  -> 

raise  INTERNAL_ERROR; 
end  case; 

end  SHOW_SET_CLAUSES; 

—  routine  to  show  a  cursor 

procedure  SHOW_CURSOR 

(  CURSOR  :  in  CURSOR_NAME  ; 

MESSAGE  :  in  STANDARD . STRING )  is 

begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  MESSAGE  );  PRINT_LINE ; 
INDENT  -7; 

SHOW_QUERY_SPEC I F ICAT ION  (  SQL_OBJECT  ( 

CURSOR. CURSOR_OB JECT . OPERANDS  )  ); 
if  CURSOR. CURSOR_OB JECT. OPERANDS. ACROSS  /»  null  then 
PRINTLINE; 

PRINT  (  "ORDER  BY  "  ); 

SHOW_ORDER_BY_CLAUSE  {  CURSOR. CURSOR_OBJECT. OPERANDS. ACROSS  ); 
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end  if; 

— PRINT  (";");  —  ("/"); 

PRINTLINE; 

—  exception 

—  when  others  ->  raise  INTERNAL_ERROR; 
end  SHOW_CURSOR; 

—  close  routine 


procedure  CLOSE  —  x 

(  CURSOR  :  in  out  CURS OR_NAME  )  is 

begin 

—  DEBUG  print  it  out 
if  WANNAJDEBUG  then 

SHOW_CURSOR  (  CURSOR,  "Cursor  closed  for:"); 
end  if; 

RDBMS_CLOSE_CURSOR 

( CURSOR . CURSOR JRDBMS . CURSOR_DATA . CURSOR_AREA ) ; 
end  CLOSE; 


—  declare  cursor  routines 

procedure  DECLAR  —  x 

(  CURSOR  :  in  out  CURSOR  JNAME; 

CURSOR_FOR  :  in  SQL_OBJECT; 

ORDER_BY  :  in  SQL_OBJECT  NULL_SQL_OBJECT  )  is 

begin 

if  CURSOR  -  null  then 

CURSOR  :»  new  CURSOR_NAME_RECORD ; 
end  if; 

CURSOR. CURSOR_OBJECT  new 

SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_DECLAR  ,  CURSOR_FOR  ); 
CURSOR_FOR. ACROSS  :«  ORDER_BY; 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  declared  for:"); 
end  if; 
end  DECLAR; 

procedure  DECLAR  —  x 

(  CURSOR  :  in  out  CURSOR_NAME ; 

CURSOR_FOR  :  in  SQL_OBJECT; 

ORDER_BY  :  in  DATABASE . COLUMN_NUMBER  )  is 

begin 

if  CURSOR  -  null  then 

CURSOR  :-  new  CURSOR_NAME_RECORD; 
end  if; 

CURSOR. CURSOR_OBJECT  new 

SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_DECLAR  ,  CURSOR_FOR  ) 
CURSOR  FOR. ACROSS  : - 
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new  SQL_OBJECT_RECORD' 

(  VALUE  ,  null  ,  (  INTEGER  ,  DATABASE. INT  (  ORDER_BY  )  )  ); 

—  DEBUG  print  it  out 

if  WANNA JDEBUG  then 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  declared  for:"); 
end  if; 
end  DECLAR; 

—  delete  routines 


procedure  DELETE_FROM_SUB 

(  TABLE  :  in  TABLE_NAME; 

WHERE  :  in  SQL_OBJECT  : =  NULL_SQL_OBJECT  )  is 

begin 

SET_INDENT  (  0  );  PRINT  (  "DELETE  "  &  TABLE . NAME . all  ); 
if  WHERE  /=  null  then 

INDENT  0;  PRINT_LINE;  PRINT  (  "WHERE  "  ); 

SHOW_SEARCH_COND IT ION  (  WHERE  ) ; 
end  if; 

— PRINT  (  "  ;"  );  —  ("  /" ) 

PRINTLINE; 
end  DELETE_FROM_SUB; 

procedure  DELETE_FROM  —  x 

(  TABLE  :  in  TABLE_NAME; 

WHERE  :  in  SQL_OBJECT  : -  NULL_SQL_OBJECT  )  is 

begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  ("Delete  from  performed  on: 
PRINTLINE;  DELETE_FROM_SUB  (TABLE,  WHERE); 
end  if; 

—  now  print  to  buffer 

SET_BUFFER  ( OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA) ; 
OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH  : -  0 
DELETE_FROM_SUB  (TABLE,  WHERE); 

UNSET_BUFFER ; 

RDBMS_OPEN_CURSOR  ( OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . 
CURSOR_AREA) ; 

RDBMS_QUERY  ( OPERAT ION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . 
QUERY_BUFFER ,  OPERAT ION_CURSOR . CURSOR_RDBMS . 

CURSOR_QUERY_DATA , QUERY_LENGTH ,  0PERATI0N_CURS0R . 

CURSOR_RDBMS . CURSOR_DATA . CURSOR_AREA) ; 

RDBMS_CLOSE_CURSOR  ( 0PERATI0N_CURS0R . CURSOR_RDRMS . 

CURSOR_DATA . CURSOR_AREA ) ; 
end  DELETE_FROM; 

—  fetch  and  into  routines 


procedure  FETCH  —  x 
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(  CURSOR  :  in  out  CURSOR_NAME  )  is 

begin 

FETCH_CURSOR  CURSOR; 

DOING_A_SELECT  FALSE; 

—  DEBUG  print  it  out 
if  WANNA_DEBUG  then 

SHOW_CURSOR  (  CURSOR  ,  "Fetch  performed  on:"  ); 
end  if; 

RDBMS_FETCH  ( CURSOR . CURSOR_RDBMS ) ; 

CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  : -  1; 

CURSOR . CURSOR_RDBMS . CURSOR_ROW_NUMBER  : - 

CURSOR. CURSOR_RDBMS.CURSOR_ROW_NUMBER  +  1; 

end  FETCH; 

procedure  INTEGER_AND_ENUMERAT I ON_I NT 0  —  x 

(VAR  :  out  USERJTYPE)  is 

TMP  :  STANDARD. INTEGER  :=  0; 


begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

PRINT  (  "INTO  with  integer  or  enumeration  argument"  );  PRINT_LINE; 
VAR  USER_TYPE ' FIRST ;  --  *****  FOR  TEST  PURPOSES 
end  if; 

RDBMS_COLUMN_REAPER  ( FETCH _CURSOR . CURSOR_RDBMS . 

CURSOR_COLUMN_NUMBER,  TMP, 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_LEN, 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_BUF ) ; 

VAR  USER_TYPE ' VAL  (TMP); 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  : - 

FETCH_CURSOR.CURSOR_RDBMS.CURSOR_COLUMN_NUMBER  +  1; 
if  DOING_A_SELECT  and 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  > 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_MAX_COLUMN  then 
CLOSE  (FETCH_CURSOR); 

DO ING_A_SELECT  FALSE; 

end  if; 

end  INTEGER_AND_ENUMERATION_INTO ; 

procedure  FLOAT_INTO  —  x 

(VAR  :  out  USERJTYPE)  is 

RESULT  :  STANDARD. FLOAT; 

begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

PRINT  (  "INTO  with  float  argument"  );  PRINT_LINE; 

VAR  USERJTYPE' SMALL;  —  FOR  TEST  PURPOSES 
end  if; 
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RDBMS_COLUMN_REAPER  ( FETCH_CURSOR . CURSOR_RDBMS . 

CURSOR_COLUMN_NUMBER , 

RESULT, 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_LEN , 
FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_BUF ) 
FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  : - 

FETCH_CURSOR.CURSOR_RDBMS.CURSOR_COLUMN_NUMBER  +  1; 
VAR  USERJTYPE  (RESULT) ; 
if  DO ING_A_SELECT  and 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  > 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_MAX_COLUMN  then 
CLOSE  (FETCH_CURSOR) ; 

DOING_A_SELECT  :=  FALSE; 
end  if; 

end  FLOAT_INTO; 

procedure  UNCONSTRAINED_STRING_INTO  —  x 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEX_TYPE )  is 

V  :  INDEXJTYPE  :=  VAR' FIRST; 

RESULT  :  STANDARD . STRING  (1..100); 

RESULT_LENGTH  :  STANDARD . INTEGER ; 

begin 

-  DEBUG  print  it  out 
if  WANNA_DEBUG  then 

PRINT  (  "INTO  with  unconstrained  string  argument”  );  PRINTJLINE; 
LAST  INDEXJTYPE' FIRST;  —  FOR  TEST  PURPOSES 
end  if; 

RDBMS_COLUMN_REAPER  ( FETCH_CURSOR . CURSOR_RDBMS . 

CURSOR_COLUMN_NTJMBER , 

RESULT,  RESULT_LENGTH, 

FETCH_CURSOR. CURSOR_RDBMS . CURSOR_RETRIEVAL_LEN, 
FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_BUF ) 
FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  : - 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  +  1 ; 

LAST  INDEXJTYPE  ( RESULT_LENGTH )  +  VAR' FIRST  -  1; 
for  I  in  1 . . RESULT_LENGTH  loop 

VAR  (V)  CONVERT_CHARACTER_TO_COMPONENT  (RESULT  (I)); 
if  V  <  INDEX_TYPE ' LAST  then 
V  V  +  I; 
end  if; 
end  loop; 

if  DOING_A_SELECT  and 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  > 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_MAX_COLUMN  then 
CLOSE  (FETCH_CURSOR) ; 

DOING_A_SELECT  FALSE; 
end  if; 

end  UNCONSTRAINED_STRING_INTO; 
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procedure  CONSTRAINED_STRING_INTO  —  x 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEXJTYPE)  is 

V  :  INDEXJTYPE  VAR' FIRST; 

RESULT  :  STANDARD . STRING  (1..100); 

RESULT  LENGTH  :  STANDARD . INTEGER; 


begin 

—  DEBUG  print  it  out 
if  WANNA_DEBUG  then 

PRINT  (  "INTO  with  constr?.ined  string  argument"  );  PRINT_LINE; 

LAST  :=  INDEXJTYPE' FIRST;  —  FOR  TEST  PURPOSES 
end  if; 

RDBMS_COLUMN_REAPER  ( FETCH_CURSOR . CURSOR_RDBMS . 

CURSOR_COLUMN_NUMBER , 

RESULT,  RESULT_LENGTH, 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_R£TRIEVAL_LEN , 
FETCH_CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_BUF ) 
FETCH_CURSOR . CURSORJRDBMS . CURSOR_COLUMN_NUMBER  : = 

FETCH JZURSOR.CURSOR_RDBMS.CURSOR_COLUMN_NUMBER  +  1; 

LAST  INDEXJTYPE  ( RESULT JUSNGTH )  +  VAR' FIRST  -  1; 
for  I  in  1 . . RESULT_LENGTH  loop 

VAR  (V)  CONVERT_CHARACTER_TO_COMPONENT  (RESULT  (I)); 
if  V  <  INDEXJTYPE ' LAST  then 
V  V  +  1; 
end  if; 
end  loop; 

if  DOING_A_SELECT  and 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  > 

FETCH_CURSOR . CURSOR_RDBMS . CURSOR_MAX_COLUMN  then 
CLOSE  (FETCHJZURSOR) ; 

DO ING_A_SELECT  :»  FALSE; 
end  if; 

end  CONSTRAINED_STRING  INTO; 


—  insert  into  routines 

procedure  INSERT_INTO_SUB 

(  TABLE  :  in  TABLE_NAME; 

WHAJ  :  in  INSERT_ITEM  )  is 

begin 

SET_INDENT  (  0  );  PRINT  (  "INSERT  INTO  "  ); 
if  TABLE, KIND  -  NAME  then 
PRINT  (  TABLE. NAME. all  ); 
else  —  must  be  0_TABLE_C0LUMN_LI ST 
PRINT  (  TABLE. OPERANDS. NAME. all  ); 

PRINT  (  "(  "  ) ; 

SH0W_SELECT_LI ST  (  TABLE. OPERANDS. ACROSS  ); 
PRINT  (  "  ) "  ) ; 
end  if; 
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PRINT_LINE; 

case  WHAT . OPERATION  is  —  must  be  an  operation 
when  0_SELEC  |  0_SELECT_DISTINCT  -> 

INDENT  -7;  SHOW_QUERY_SPECIFICATION  (  SQL_OBJECT  (  WHAT  )  ); 
when  0_LE  |  0_AND  -> 

PRINT  (  "VALUES  (");--(*<"); 

SHOW_INSERT_VALUE_LI ST  (  SQL_OBJECT  (  WHAT  )  ); 

PRINT  (")"); 
when  others  **> 

raise  INTERN AL_ERROR ; 
end  case; 

— PRINT  (";");  —  ( "  /" ) 

PRINTLINE; 
end  INSERT_INTO_SUB; 

procedure  INSERT_INTO  —  x 

(  TABLE  :  in  TAB LE_NAME ; 

WHAT  :  in  INSERT_ITEM  )  is 

begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  ("Insert  into  performed  on:"); 
PRINTLINE;  INSERT_INTO_SUB  (TABLE,  WHAT); 
end  if; 

—  now  for  real 

SET_BUFFER  ( OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA ) ; 
OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH  0; 
INSERT_INTO_SUB  (TABLE,  WHAT); 

UNSET_BUFFER ; 

RDBMS_OPEN_CURSOR  ( OPERATION_CURSOR . CURSOR_RDBMS . 

CURSOR_DATA.CURSOR_AREA) ; 

RDBMS_QUERY  ( 0PERATI0N_CURS0R . CURS0R_RDBMS . 

CURSOR_QUERY_DATA . QUERY JBUFFER , 

0PERATI0N_CURS0R . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH , 
OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . CURSOR_AREA ) ; 
RDBMS_CLOSE_CURSOR  ( OPERATION_CURSOR . CURSOR_RDBMS . 

CURSOR_DATA . CURSOR_AREA ) ; 
ei^  INSERT_INTO; 

function  VALUES  return  INSERT_ITEM  is 
begin 

return  new  SQL_0B JECT_RECORD '  (  OPERATION  ,  null  ,  0_VALUES  ,  null  ) 
end  VALUES; 

—  open  routine 

procedure  OPEN  —  x 

(  CURSOR  :  in  out  CURS0R_NAME  )  is 

XI  :  STANDARD . INTEGER  0; 

X2  :  STANDARD . INTEGER  0; 
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begin 

if  CURSOR. CURSOR_RDBMS.CURSOR_DATA  -  null  then 

CURSOR . CURSOR_RDBMS . CURSOR_DATA  new  CURSOR_DATA_T YPE ; 

end  if ; 

CURSOR . CURSOR_RDBMS . CURSOR_DATA . ROWID  (1..18  ->  '  '); 

CURSOR . CURSOR_RDBMS .  CURSOR_DATA .  CURSOR_AREA .  RETURN_CODE  0; 

CURSOR .  CURSOR_RDBMS .  CURSOR_DATA .  CURSOR_AREA .  F I LLER_DAT A_1  :  - 
(0,  0,  0/  0/  0); 

CURSOR .  CURSOR_RDBMS .  CURSOR_DATA .  CURSOR_AREA .  V4_ERROR_CODE  0  ; 

CURSOR .  CURSOR_RDBMS  .  CURSOR_DATA .  CURSOR_AREA .  FILLER_DATA_2  :  - 

(0/  0/  Of  Of  Of  0 f  0,  0,  0,  0/ 

0/  0 f  Of  0,  0/  0,  0/  0,  Of  Of  Of  Of  Of  Of  0)/ 

if  CURSOR. CURSOR_RDBMS.CURSOR_QUERY_DATA  -  null  then 
CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA  : - 

new  ORACLE_CURSOR_DEFINITIONS . QUERY_BUFFER_RECORD; 
CURSOR .  CURSOR_RDBMS .  CURSOR_QUERY_DATA .  QUERY_BUFFER  :  - 
new  ORACLE_CURSOR_DEFINITIONS.BUFFER_TYPE; 

end  if; 

if  CURSOR .  CURSOR_RDBMS .  CURSOR_QUERY_DATA .  QUERY_BUFFER  -  null  then 
CURSOR .  CURSORJRDBMS .  CURSOR_QUERY_DATA .  QUERY_B UFFER  :  - 
new  ORACLE_CURSOR_DEFINITIONS . BUFFERJTYPE; 

end  if ; 

CURSOR .  CURSOR_RDBMS .  CURSOR_QUERY_DATA .  QUERYJLENGTH  0; 

CURSOR . CURSOR_RDBMS . CURSOR_COLUMN_NUMBER  :«  0; 

CURSOR . CURSOR_RDBMS . CURSOR JiAX_COLUm  :=  0/ 

CURSOR. CURSOR_RDBMS.CURSOR~ROW_NUMBER  0; 

CURSOR . CURSOR_RDBMS . CURSOR_FIRST_FETCH  TRUE; 

CURSOR. CURSOR_RDBMS . CURSOR_RETRXEVAL_LEN  0; 

CURSOR . CURSOR_RDBMS . CURSOR_RETRIEVAL_BUF  i-  (others  ->  •  '); 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  opened  for:"); 
end  if; 

—  now  to  the  buffer 

SET_BUFFER  ( CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA ) ; 

CURSOR. CURSOR_RDBMS.CURSOR_QUERY_DATA.QUERY_LENGTH  0; 

XI  :  -  CURSOR .  CURSOR_RDBMS  .  CURSOR_QUERY_DATA .  QUERY_BUFFER '  FIRST  ; 

X2  CURSOR . CURSOR_RDBMS  . CURSOR_QUERY_DATA .  QUERY_BUFFER ' LAST ; 

SHOW_CURSOR  (  CURSOR  ,  "*); 

UNSET_BUFFER; 

RDBMS_OPEN_CURSOR 

( CURSOR . CURSOR_RDBMS . CURSOR_DATA . CURSOR_AREA ) ; 

RDBMS_QUERY  ( CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_BUFFER , 
CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH , 
CURSOR . CURSOR_RDBMS . CURSOR_DATA . CURSOR_AREA ) ; 

CURSOR. CURSOR_RDBMS.CURSOR_FIRST_FETCH  TRUE; 
end  OPEN; 

—  select  statement  routines 

procedure  SHOW_SELECT  (  S  :  in  SQL_OBJECT  )  is 
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begin 

INDENT  -7; 

SHOW_Q UERY_S P ECIFICATION  (  S  ); 

--PRINT  (  "  ;"  );  —  ("  /") 

PRINT  JUNE; 
exception 

when  others  ->  raise  INTERN AL_ERROR ; 
end  SHOW_SELECT; 

procedure  SELECT_LIST_SELECT  —  x 

(  WHAT  :  in  WHAT_TYPE ; 

FROM  :  in  TABLE_LIST; 

WHERE  :  in  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

GROUP_BY  :  in  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

HAVING  :  in  SQL_OBJECT  NULL_SQL_OBJECT  )  is 
TMP  :  SQL_OB JECT ; 

begin 

TMP 

(  BUILD_SELECT 
(  SELECTJIYPE, 

L_CONVERT  (  WHAT  )  ,  FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ); 

-  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BIjANK_IiINE ;  SET_INDENT  (  0  );  PRINT  ("Select  performed  on:"); 
PRINTLINE;  SHOW_SELECT  (TMP); 
end  if; 

-  open  will  print  to  output  for  debug  and  to  the  query  too 

DECLAR  (OPERATION_CURSOR,  TMP); 

OPEN  (OPERATION_CURSOR); 

if  OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . CUR SOR_AREA . 
FILLER_DATA_1  (2)  >1  then 
raise  UNIQUE_ERROR ; 
end  if; 

FETCH  (OPERATION_CURSOR) ; 

DO ING_A_SELECT  TRUE; 

end  SELECT_LIST_SELECT; 

procedure  STAR_SELECT 
(  FROM 
WHERE 
GROUP_BY 
HAVING 

TMP  :  SQL 

begin 
TMP  :« 

(  BUILD_SELECT 
(  SELECT_TYPE, 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_STAR  ,  null  ), 
FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ) ; 


—  x 

in  TABLE_LIST; 

in  SQL_OBJECT  NULL_SQL_OB JECT ; 

in  SQL_OBJECT  NULL_SQL_OB JECT ; 

in  SQL_OBJECT  NULL_SQL_OBJECT  )  is 

OBJECT; 


69 

UNCLASSIFIED 


UNCLASSIFIED 


—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  ("Select  performed  on:"); 
PRINTLINE;  SHOW_SELECT  (IMP); 
end  if; 

—  open  will  print  for  debug  and  to  the  buffer  too 

DECLAR  ( OPERAT I ON_CURSOR ,  TMP); 

OPEN  (OPERATION_CURSOR); 

if  OPERAT ION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . CURS 0R_ AREA . 

P I LLBR_D  ATA__1  (2)  >1  then 
raise  UNIQUE_ERROR ; 
end  if; 

FETCH  (OPERATION_CURSOR) ; 

DOING_A_SELECT  TRUE; 
end  STAR_SELECT; 


—  update  routines 

procedure  UPDATE_SUB 

(  TABLE  :  in  TABLE_NAME; 

SET  :  in  SQL_OBJECT; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OBJECT  )  is 

begin 

SET_INDENT  (  0  );  PRINT  (  "UPDATE  "  6  TABLE. NAME. all  ); 

PRINT_LINE;  PRINT  (  "SET  "  );  SET_INDENT  (  4  );  SHOW_SET_CLAUSES  | 
if  WHERE  /-  null  then 

INDENT  0;  SET_INDENT  (  0  );  PRINTLINE;  PRINT  (  "WHERE  "); 
SHOW_SEARCH_CONDITION  (  WHERE  ); 
end  if; 

— PRINT  (  "  ;"  );  —  ("  /") 

PRINTLINE; 
end  UPDATE_SUB ; 

procedure  UPDATE  —  x 

(  TABLE  :  in  TABLE_NAME; 

SET  :  in  SQL_OB JECT ; 

WHERE  :  in  SQL_OBJECT  NULL_SQL_OBJECT  )  is 

begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  ("Update  performed  on:"); 
PRINTLINE;  UPDATE_SUB  (TABLE,  SET,  WHERE); 
end  if; 

—  now  into  the  buffer 

SET_BUFFER  ( OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA ) ; 
OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH  0; 
UPDATE_SUB  (TABLE,  SET,  WHERE); 

UNSET_BUFFER; 

RDBMS_OPEN_CURSOR  ( OPERAT ION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . 
CURSOR_AREA) ; 

RDBMS_QUERY  ( OPERAT ION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . 


SET  ) 
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QUERY_BUFFER, 

OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_LENGTH , 
OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_DATA . CURSOR_AREA ) ; 
RDBMS_CLOSE_CURSOR  { OPERATION_CURSOR . CURSOR_RDBMS . CUR SOR_D AT A . 
CURSOR_AREA) ; 
end  UPDATE; 

procedure  OPEN_DATABASE 

(DATABASE_NAME  :  in  STANDARD . STRING ; 

PASSWORD  :  in  STANDARD . STRING )  is 

BUP  :  ORACLE_CURSOR_DEFINITIONS.BUFFER_ACCESS_TYPE  null; 

BUF_LEN  :  STANDARD . INTEGER  : =  0; 

BUFX  :  ORACLE_CURSOR_DEFINITIONS . BUFFER_ACCESS_TYPE  :*  null; 

BUFX_LEN  :  STANDARD . INTEGER  0; 

begin 

if  BUF  *  null  then 

BUF  :**  new  BUFFER_TYPE; 
end  if; 

if  BUFX  -  null  then 

BUFX  new  BUFFERJEYPE; 
end  if ; 

BUF_LEN  DATABASE_NAME ' LENGTH  +  1  +  PASSWORD ' LENGTH ; 

BUF  (l..BUF_LEN)  : -~DATABASE_NAME  &  */"  &  PASSWORD; 

BUF_LEN  DATABASE_NAME ' LENGTH ; 

BUF  ( 1 . . BUF_LEN )  : -  DATABASE_NAME ; 

BUFX_LEN  PASSWORD' LENGTH; 

BUFX  ( 1 . . BUFX_LEN)  : «  PASSWORD; 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_L INE ;  SET_INDENT  (  0  );  PRINT  (  "OPEN  DATABASE  for  "  & 

BUF  (l..BUF_LEN)  &  "  "  S  BUFX  ( 1 . . BUFX_LEN ) ) ;  PRINT_LINE; 
end  if; 

RDBMS_OPEN_DATABASE  (BUF,  BUF_LEN ,  BUFX,  BUFX_LEN) ; 
end  OPEN_DATABASE; 

procedure  EXIT_DATABASE  is 
begin 

—  DEBUG  print  it  out 

if  WANNA_DEBUG  then 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  "CLOSE  DATABASE");  PRINT_LINE; 
end  if; 

RDBMS_EXIT_DATABASE ; 
end  EXIT  DATABASE; 


begin 

OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA  : - 

new  ORACLE_CURSOR_DEFINITIONS. QUERY_BUFFER_RECORD; 
OPERAT ION_CURSOR . CURSOR_RDBMS . CURSOR_QUERY_DATA . QUERY_BUFFER  : - 
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new  ORACLE_CURSOR_DEFINITIONS.BUFFER_TYPE;  • 

OPERATION_CURSOR . CURSOR_RDBMS . CURSOR_DATA  new  CURSOR_DATA_TYPE ; 

end  ADA_SQL_FUNCTIONS; 

3.10.11  package  CURSOR_DEFINmON.ADA 

with  ADA_SQL_FUNCTIONS; 

package  CURSOR_DEFINITION  is 

subtype  CURSOR_NAME  is  ADA_SQL_FUNCTIONS . CURSOR_NAME; 

end  CURSOR_DEFINITION; 

3.10.12  package  SCHEMA_DEFINITION.ADA 

package  SCHEMA_DEFINITION  is 
type  IDENTIFIER  is  range  1..5; 
generic 

function  AUTHORIZATION_IDENTIFIER  return  IDENTIFIER;  # 

end  SCHEMA_DEFINITION; 

package  body  SCHEMA_DEFINITION  is 

function  AUTHORIZATION_IDENTIFIER  return  IDENTIFIER  is 
begin 

return  1;  # 

end  AUTHORIZATION_IDENTIFIER; 

end  SCHEMA_DEFINITION; 
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